Shareware Super Platinum 8

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / GENSCR.ZIP;1 / GENSCRNX.PRG < prev next >

Wrap

Text File | 1993-08-10 | 142.6 KB | 5,141 lines

*************************************************************************** * * Procedure file: GENSCRNX.PRG * System: GenScrnX * Version: 1.6b * Author: Ken R. Levy * Company: Jet Propulsion Laboratory * Copyright: None (Public Domain) * *************************************************************************** * * GENSCRNX - Screen Database Generator. * * Description: * This program generates database from objects designed and built with * FoxPro screen builder. * * Notes: * In this program, for clarity/readability reasons, variable names * are used that are longer than 10 characters. Note, however, that only * the first 10 characters are significant. * PARAMETERS m.projdbf,m.recno,m.dummy PRIVATE m.projdbf,m.recno,m.dummy PRIVATE m.gstatus,m.gsx_mode,m.fconfigfp,m.cr,m.lf,m.cr_lf,m.null PRIVATE m.genscrn,m.genscrnx,m.warnings,m.gsxversion,m.mvcount PRIVATE m.transport,m.transportx,m.ftrndrv1,m.ftrndrv2 PRIVATE m.pathfox,m.fgenscx,m.fupdspr,m.ffoxscx,m.ffoxscx2,m.projpath PRIVATE m.fscxbase,m.fscxdata,m.fsprout,m.fspxout,m.fsprout2 PRIVATE m.spxout2,m.fsprerr,m.compspr,m.dispspr,m.autorun PRIVATE m.platonly,m.autohalt,m.outtxt,m.lastselect PRIVATE m.inclibs,m.baslibs,m.fromproj,m.fcountadj,m.fnctnames PRIVATE m.lastonerror,m.lastsetcomp,m.lastsetexac,m.lastsetpath PRIVATE m.lastsetsfty,m.lastsetexcl,m.lastsetudfp,m.lastsetcur,m.lastmemow PRIVATE m.c_defobj,m.c_basobj,m.c_insobj,m.c_insscx,m.c_inclib,m.c_deflib PRIVATE m.c_baslib,m.c_trntxt,m.c_memvar,m.c_instxt,m.c_delete,m.c_delobj PRIVATE m.c_if,m.c_size,m.c_nosize,m.c_svsize,m.c_svpict,m.c_basbefore PRIVATE m.c_defobj,m.c_group,m.c_default,m.c_name,m.p_name,m.s_para PRIVATE m.c_pjx_set,m.c_set,m.c_insert,m.p_insert,m.c_prg,m.c_outfile PRIVATE m.c_endtxt,m.c_function,m.c_endfnct,m.c_method,m.c_endmthd PRIVATE m.c_nogen,m.c_noxgen,m.c_section3,m.c_autorun,m.c_noautorun PRIVATE m.c_compspr,m.c_nocompspr,m.c_dispspr,m.c_nodispspr,m.c_genscrnx PRIVATE m.m_deflib,m.m_defobj,m.m_basobj,m.m_instxt,m.m_delete PRIVATE m.m_if,m.m_size,m.m_nosize,m.m_svsize,m.m_svpict,m.m_basbefore PRIVATE m.m_default,m.m_errline,m.m_section3,m.m_method PRIVATE m.scx_name,m.memline,m.i,m.newsetpath,m.pjxset,m.eval_cmnt PRIVATE m.r_projbase,m.r_scxdata,m.platform_,m.cplatform_,m.splatform_ PRIVATE m.lib_mode,m.gen_mode,m.xgen_mode,m.scxcount,m.allplatforms,m.drv_no PRIVATE m.msg1,m.msg2,m.msg3,m.nextfile,m.memtemp1,m.memtemp2,m.memtemp3 PRIVATE m.c_dlgface,m.c_dlgsize,m.c_dlgstyle,m.badchars,m.stdascii DIMENSION a_fscxdrv(8),a_scxdrv(1,8),a_scxdrvs(8),a_scxdrvm(8),a_c_scxdrv(8) DIMENSION a_fsprdrv(6),a_sprdrv(1,6),a_sprdrvs(6),a_sprdrvm(8),a_c_sprdrv(6) m.gsxversion='1.6a' _FOX25=('2.5'$VERSION()) _FOX25REV=IIF(_FOX25,SUBSTR(VERSION(),AT('2.5',VERSION())+3,1),'') IF .NOT._FOX25 _DOS=.T. _WINDOWS=.F. _MAC=.F. _UNIX=.F. ENDIF DO CASE CASE _WINDOWS m.cplatform_='WINDOWS' CASE _MAC m.cplatform_='MAC' CASE _UNIX m.cplatform_='UNIX' OTHERWISE m.cplatform_='DOS' ENDCASE m.cplatform_=PADR(m.cplatform_,8) IF TYPE('m.recno')#'N' m.recno=0 ENDIF m.gsx_mode=m.recno>=2.AND.ATC('.PJX',m.projdbf)>0 m.gstatus=0 m.warnings=0 m.pathfox=SYS(2004) m.cr=CHR(13) m.lf=CHR(10) m.cr_lf=m.cr+m.lf m.null=CHR(0) DIMENSION a_file_ext(4) a_file_ext(1)='.EXE' a_file_ext(2)='.APP' a_file_ext(3)='.PRG' a_file_ext(4)='.FXP' m.lastselect=SELECT() m.lastsetpath=SET('PATH') m.fconfigfp=SYS(2019) IF FILE(m.fconfigfp) CREATE CURSOR CONFIGFP (FP M) INSERT BLANK APPEND MEMO FP FROM (m.fconfigfp) OVERWRITE REPLACE FP WITH evltxt(FP) ELSE m.fconfigfp='' ENDIF m.mvcount=configfp('MVCOUNT','256') IF VAL(m.mvcount)<512 =warning("'MVCOUNT="+m.mvcount+"' should be set to at least 512 in "+; SYS(2019)) ENDIF m.genscrnx=IIF(TYPE('_GENSCRNX')=='C',UPPER(_GENSCRNX),configfp('GENSCRNX','ON')) m.genscrn=add_fext(configfp('_GENSCRNX',m.pathfox+'GENSCRN.PRG')) m.ffoxscx=configfp('_FOXSCX',m.pathfox+'FOXSCX.DBF') IF .NOT.EMPTY(m.ffoxscx).AND..NOT.'.'$m.ffoxscx m.ffoxscx=m.ffoxscx+'.DBF' ENDIF IF TYPE('m.projdbf')#'C' m.i=openfoxscx() IF USED('CONFIGFP') USE IN CONFIGFP ENDIF IF .NOT.m.i RETURN .F. ENDIF m.memline="PLATFORM=='"+m.cplatform_+"'" SET FILTER TO &memline RETURN .T. ENDIF IF .NOT.m.gsx_mode m.transport=add_fext(configfp('_TRANSPRTX',m.pathfox+'TRANSPRT.PRG')) m.ftrndrv1=add_fext(configfp('_trndrv1','')) m.ftrndrv2=add_fext(configfp('_trndrv2','')) IF USED('CONFIGFP') USE IN CONFIGFP ENDIF IF FILE(m.ftrndrv1) DO (m.ftrndrv1) WITH m.projdbf,m.recno,m.dummy IF m.gstatus=-2 RETURN 0 ENDIF IF m.gstatus=-1 RETURN -1 ENDIF ENDIF IF .NOT.FILE(m.transport) RETURN -1 ENDIF m.transport=trimext(m.transport) RELEASE ALL LIKE ?_* SET PATH TO (m.pathfox) macrofnct='m.gstatus='+trimpath(m.transport)+'(m.projdbf,m.recno,m.dummy)' ¯ofnct IF EMPTY(m.lastsetpath) SET PATH TO ELSE SET PATH TO (m.lastsetpath) ENDIF IF FILE(m.ftrndrv2) DO (m.ftrndrv2) WITH m.projdbf,m.recno,m.dummy ENDIF RETURN m.gstatus ENDIF IF m.genscrnx=='OFF' IF USED('CONFIGFP') USE IN CONFIGFP ENDIF IF .NOT.FILE(m.genscrn) RETURN 2 ENDIF RELEASE ALL LIKE ?_* RELEASE ALL LIKE f* RELEASE ALL LIKE last* DO (m.genscrn) WITH m.projdbf,m.recno RETURN m.gstatus ENDIF m.fgenscx=configfp('_GENSCX','GENSCX') m.fupdspr=configfp('_UPDSPR','UPDSPR') FOR m.i = 1 TO 8 a_scxdrvm(m.i)=0 a_fscxdrv(m.i)=add_fext(configfp('_SCXDRV'+STR(m.i,1),'')) IF m.i>6 LOOP ENDIF a_sprdrvm(m.i)=0 a_fsprdrv(m.i)=add_fext(configfp('_SPRDRV'+STR(m.i,1),'')) ENDFOR m.compspr=IIF(TYPE('_COMPSPR')=='C',UPPER(_COMPSPR),; configfp('COMPSPR','OFF')) m.dispspr=IIF(TYPE('_DISPSPR')=='C',UPPER(_DISPSPR),; configfp('DISPSPR','OFF')) m.autorun=IIF(TYPE('_AUTORUN')=='C',UPPER(_AUTORUN),; configfp('AUTORUN','OFF')) m.platonly=IIF(TYPE('_PLATONLY')=='C',UPPER(_PLATONLY),; configfp('PLATONLY','OFF')) m.autohalt=IIF(TYPE('_AUTOHALT')=='C',UPPER(_AUTOHALT),; configfp('AUTOHALT','ON')) m.outtxt=IIF(TYPE('_OUTTXT')=='C',UPPER(_OUTTXT),; configfp('OUTTXT','OFF')) SET ESCAPE OFF m.lastonerror=ON('ERROR') ON ERROR DO errorhnd WITH ERROR(),MESSAGE(),PROGRAM(),LINENO(),MESSAGE(1) m.lastsetcomp=SET('COMPATIBLE') SET COMPATIBLE OFF m.lastsetexac=SET('EXACT') SET EXACT OFF m.lastsetsfty=SET('SAFETY') SET SAFETY OFF m.lastsetexcl=SET('EXCLUSIVE') SET EXCLUSIVE ON m.lastsetudfp=SET('UDFPARMS') SET UDFPARMS TO VALUE SET CURSOR OFF m.lastmemow=SET('MEMOWIDTH') SET MEMOWIDTH TO 254 ACTIVATE SCREEN IF WEXIST('_weditfile') RELEASE WINDOW _weditfile ENDIF IF _WINDOWS SET MESSAGE TO '' ENDIF m.c_defobj='*:DEFOBJ' m.c_basobj='*:BASOBJ' m.c_insobj='*:INSOBJ' m.c_insscx='*:INSSCX' m.c_inclib='*:INCLIB' m.c_deflib='*:DEFLIB' m.c_baslib='*:BASLIB' m.c_instxt='*:INSTXT' m.c_trntxt='*:TRNTXT' m.c_memvar='*:MEMVAR' FOR m.i = 1 TO 8 a_c_scxdrv(m.i)='*:SCXDRV'+STR(i,1) a_scxdrvs(m.i)=0 IF m.i>6 LOOP ENDIF a_c_sprdrv(m.i)='*:SPRDRV'+STR(i,1) a_sprdrvs(m.i)=0 ENDFOR m.c_delete='*:DELETE' m.c_delobj='*:DELOBJ' m.c_if='*:IF' m.c_size='*:SIZE' m.c_nosize='*:NOSIZE' m.c_svsize='*:SAVESIZE' m.c_svpict='*:SAVEPICT' m.c_basbefore='*:BASBEFORE' m.c_group='*:GROUP' m.c_default='*:DEFAULT' m.c_nogen='*:NOGEN' m.c_noxgen='*:NOXGEN' m.c_compspr='*:COMPSPR' m.c_nocompspr='*:NOCOMPSPR' m.c_dispspr='*:DISPSPR' m.c_nodispspr='*:NODISPSPR' m.c_autorun='*:AUTORUN' m.c_noautorun='*:NOAUTORUN' m.c_genscrnx='*:GENSCRNX' m.c_insert='#:INSERT' m.p_insert='#INSE' m.c_name='*:NAME' m.p_name='#NAME' m.s_para='PARA' m.c_prg='*:PRG' m.c_outfile='*:OUTFILE' m.c_pjxset='*:PJXSET' m.c_set='*:SET' m.c_section3='#:SECTION 3' m.c_endtxt='*:ENDTXT' m.c_function='*:FUNCTION' m.c_method='*:METHOD' m.c_endfnct='*:ENDFNCT' m.c_endmthd='*:ENDMTHD' m.m_deflib='*-:DEFLIB' m.m_defobj='*-:DEFOBJ' m.m_basobj='*-:BASOBJ' m.m_instxt='*-:INSTXT' m.m_delete='*-:DELETE' m.m_if='*-:IF' m.m_size='*-:SIZE' m.m_nosize='*-:NOSIZE' m.m_svsize='*-:SAVESIZE' m.m_svpict='*-:SAVEPICT' m.m_basbefore='*-:BASBEFORE' m.m_default='*-:DEFAULT' m.m_section3='*-#SECTION 3' m.m_method='*-:METHOD' m.m_errline='Error in line ' m.c_dlgface="MS Sans Serif" m.c_dlgsize=8.000 m.c_dlgstyle="B" m.badchars=' /\,-=:;{}[]!@#$%^&*.<>()+|'+CHR(34)+CHR(39) m.stdascii='' m.eval_cmnt='SUBSTR(COMMENT,MAX(ATC(m.c_defobj,COMMENT),'+; 'ATC(m.m_defobj,COMMENT)))' DIMENSION a_inclib(1),a_baslib(1) m.inclibs=0 m.baslibs=0 DIMENSION a_fnctname(1,2) m.fnctnames=0 DIMENSION a_scxalias(16),a_fscxdata(1),a_scxupd(1) a_scxupd='' m.scxcount=0 m.platform_='' m.splatform_=m.cplatform_ m.fcountadj=IIF(_FOX25,8,9) a_scxdrv='' a_sprdrv='' m.ffoxscx2='' m.fscxbase='' m.fscxdata='' m.fsprout='' m.fspxout='' m.fsprerr='' m.scx_name='' m.newsetpath='' m.projpath='' m.lib_mode=.F. m.gen_mode=.T. m.xgen_mode=.T. m.fromproj=.T. m.pjxset=.F. m.drv_no=0 m.r_pjxbase=m.recno m.r_scxdata=1 m.allplatforms=.F. IF .NOT.EMPTY(m.ffoxscx) IF m.fgenscx=='GENSCX'.OR.FILE(m.fgenscx) CLEAR TYPEAHEAD DO (m.fgenscx) WITH m.projdbf,m.recno ELSE =warning('_GENSCX =',m.fgenscx) m.fgenscx='' ENDIF ELSE m.fgenscx='' ENDIF RELEASE a_fscxdrv,a_scxdrv,a_scxdrvs,a_scxdrvm,a_c_scxdrv IF m.gen_mode IF FILE(m.genscrn) IF EMPTY(m.lastsetpath) SET PATH TO ELSE SET PATH TO (m.lastsetpath) ENDIF m.memtemp1=uniquefile()+'.MEM' SAVE TO (m.memtemp1) ALL LIKE ?_* RELEASE ALL LIKE ?_* m.memtemp2=uniquefile()+'.MEM' SAVE TO (m.memtemp2) ALL LIKE f* RELEASE ALL LIKE f* m.memtemp3=uniquefile()+'.MEM' SAVE TO (m.memtemp3) ALL LIKE last* RELEASE ALL LIKE last* CLEAR TYPEAHEAD ON ERROR DO (m.genscrn) WITH m.projdbf,m.recno SET ESCAPE OFF ON ERROR DO errorhnd WITH ERROR(),MESSAGE(),PROGRAM(),LINENO(),MESSAGE(1) IF _WINDOWS SET MESSAGE TO '' ENDIF IF FILE(m.memtemp1) RESTORE FROM (m.memtemp1) ADDITIVE ERASE (m.memtemp1) ENDIF IF FILE(m.memtemp2) RESTORE FROM (m.memtemp2) ADDITIVE ERASE (m.memtemp2) ENDIF IF FILE(m.memtemp3) RESTORE FROM (m.memtemp3) ADDITIVE ERASE (m.memtemp3) ENDIF DO restoreenv ELSE =warning('_GENSCRNX =',m.genscrn) m.genscrn='' ENDIF ELSE m.genscrn='' ENDIF IF m.xgen_mode.AND..NOT.lib_mode.AND.FILE(m.fsprout) IF m.fupdspr=='UPDSPR'.OR.FILE(m.fupdspr) CLEAR TYPEAHEAD DO (m.fupdspr) WITH m.projdbf,m.recno ELSE =warning('_UPDSPR =',m.fupdspr) m.fupdspr='' ENDIF ELSE m.fupdspr='' ENDIF DO cleanup WITH .T. RETURN m.gstatus * END GENSCRNX.PRG FUNCTION genscx PARAMETER m.projdbf,m.recno PRIVATE m.screenset,m.obj_lib,m.obj_name,m.obj_base,m.obj_field,m.obj_expr PRIVATE m.lib_name,m.lib_upd,m.loop_plat,m.loop_flag,m.loop_obj,m.loop_def PRIVATE m.lastslct,m.lastexac,m.lastfilter,m.winrelease,m.scx_file PRIVATE m.insscxs,m.memvarmode,m.basbefore,m.screenend,m.setupcd PRIVATE m.basobjs,m.setfilter,m.field_name,m.field_eval,m.field_type PRIVATE m.old_text,m.new_text,m.match,m.match_drv,m.match_pos,m.match_no PRIVATE m.snpttype,m.snptname,m.snptname_,m.storesize,m.fnctname,m.paramlist PRIVATE m.name_mode,m.scx_alias,m.file_ext,m.comp_flag,m.gsx_flag,m.set_mode PRIVATE m.rec_count,m.rec_total,m.str_data,m.str_data2,m.str_data3 PRIVATE m.r,m.r2,m.memline,m.at_pos,m.at_pos2,m.at_line,m.i,m.j,m.k m.lastslct=SELECT() IF USED('FOXSCX') USE IN FOXSCX ENDIF IF USED('_PJXDATA') SELECT _PJXDATA USE ELSE SELECT 0 ENDIF IF USED('PJXBASE') USE IN PJXBASE ENDIF IF USED('PJXDATA') SELECT PJXDATA USE ELSE SELECT 0 ENDIF USE (m.projdbf) AGAIN ALIAS PJXBASE SET FILTER TO .NOT.DELETED() LOCATE IF .NOT.TYPE=='H' LOCATE FOR TYPE=='H' IF EOF() USE SELECT (m.lastslct) RETURN m.gstatus ENDIF ENDIF m.projpath=MLINE(NAME,1) IF .NOT.'\'$m.projpath m.projpath=FULLPATH(m.projpath,m.projdbf) ENDIF m.projdbf=FULLPATH(uniquefile(),m.projdbf) GOTO m.recno IF TYPE==m.null m.recno=2 ELSE m.recno=3 ENDIF m.i=SETID IF m.i=0 m.fromproj=.F. ENDIF IF m.i=0 COPY TO (m.projdbf) ELSE COPY TO (m.projdbf) FOR SETID=m.i.AND.UPPER(TYPE)=='S' ENDIF LOCATE SELECT PJXBASE LOCATE FOR TYPE=='H' IF EOF() LOCATE ENDIF IF RECNO()>m.r_pjxbase m.r_pjxbase=m.r_pjxbase+1 ENDIF RELEASE a_scatter SCATTER TO a_scatter MEMO SELECT 0 USE (m.projdbf) ALIAS PJXDATA LOCATE IF m.i#0 INSERT BLANK BEFORE GATHER FROM a_scatter MEMO REPLACE SETID WITH m.i ENDIF RELEASE a_scatter LOCATE FOR TYPE==m.null.OR.TYPE=='S' IF m.fromproj.AND.RECNO()<=2 SCATTER TO a_scatter MEMO DELETE APPEND BLANK GATHER FROM a_scatter MEMO RELEASE a_scatter PACK LOCATE FOR TYPE==m.null.OR.TYPE=='S' m.r_pjxbase=RECNO() ENDIF IF EOF() USE SELECT (m.lastslct) RETURN m.gstatus ENDIF m.recno=RECNO() DO CASE CASE TYPE('SAVECODE')#'L' m.allplatforms=.T. CASE m.platonly=='ON' m.allplatforms=.F. REPLACE SAVECODE WITH .T. CASE m.platonly=='OFF' m.allplatforms=.T. REPLACE SAVECODE WITH .F. OTHERWISE m.allplatforms=.NOT.SAVECODE ENDCASE m.memline=MLINE(OUTFILE,1) IF m.fromproj m.fsprout=FULLPATH(STRTRAN(ALLTRIM(m.memline),m.null,''),m.projpath) ELSE IF _WINDOWS m.fsprout=SUBSTR(FULLPATH(STRTRAN(STRTRAN(ALLTRIM(m.memline),; '..\',''),m.null,'')),3) IF ':'$m.memline m.fsprout=LEFT(m.memline,2)+m.fsprout ENDIF ELSE m.fsprout=FULLPATH(STRTRAN(ALLTRIM(m.memline),m.null,''),m.projpath) ENDIF ENDIF IF .NOT.':'$m.fsprout SKIP -1 IF SUBSTR(MLINE(NAME,1),2,1)==':' m.fsprout=LEFT(MLINE(NAME,1),2)+m.fsprout ENDIF ENDIF GOTO m.recno m.fromproj=.NOT.EMPTY(TYPE).AND.ASC(TYPE)>0 IF m.fromproj m.at_pos=RAT('\',m.projpath) IF m.at_pos>0 IF .NOT.LEFT(m.fsprout,1)=='\'.AND..NOT.':'$m.fsprout m.fsprout=LEFT(m.projpath,m.at_pos)+m.fsprout ENDIF ELSE LOCATE m.fsprout=FULLPATH(m.fsprout,HOMEDIR) ENDIF ELSE m.fsprout=FULLPATH(m.fsprout,HOMEDIR) ENDIF GOTO m.recno m.file_ext=UPPER(RIGHT(m.fsprout,4)) DO CASE CASE m.file_ext=='.SPR' m.file_ext='.SPX' CASE m.file_ext=='.MPR' m.file_ext='.MPX' OTHERWISE m.file_ext='.FXP' ENDCASE m.fspxout=trimext(m.fsprout)+m.file_ext m.fsprerr=trimext(m.fsprout)+'.ERR' IF m.fromproj REPLACE OUTFILE WITH m.fsprout+m.null, HOMEDIR WITH '' ENDIF m.winrelease=trimpath(m.fsprerr) IF WEXIST(m.winrelease) RELEASE WINDOW (m.winrelease) ENDIF IF FILE(m.fsprerr) ERASE (m.fsprerr) ENDIF IF FILE(m.fspxout) ERASE (m.fspxout) ENDIF IF m.fromproj SELECT PJXBASE GOTO m.r_pjxbase IF RECNO()>=4 SKIP -2 IF .NOT.EOF() GOTO m.r_pjxbase SKIP -1 m.i=0 IF ATC('.SCX',NAME)=0 SKIP 2 ENDIF SKIP -1 IF ATC('.SPR',NAME)=0 SKIP -1 ENDIF IF ATC('.SPR',NAME)>0 m.fsprout2=FULLPATH(STRTRAN(ALLTRIM(MLINE(NAME,1)),m.null,''),m.fsprout) m.fspxout2=trimext(m.fsprout2)+'.SPX' IF FILE(m.fsprout2).AND..NOT.FILE(m.fspxout2) IF ADIR(a_dir,m.fsprout2)=1.AND.a_dir(1,2)=0 ERASE (m.fsprout2) ENDIF RELEASE a_dir ENDIF ENDIF ENDIF ENDIF ENDIF m.screenend=.F. IF m.fromproj SELECT PJXBASE GOTO m.r_pjxbase m.i=SETID SKIP 2 IF EOF().OR.SETID=0 m.screenend=.T. ENDIF ENDIF SELECT PJXBASE IF m.recno>RECCOUNT() LOCATE FOR TYPE==m.null.OR.TYPE=='S' IF EOF() LOCATE ELSE m.recno=RECNO() ENDIF ENDIF GOTO m.recno m.msg1='' m.loop_plat=.F. m.screenset=.F. m.comp_flag=.F. DO WHILE .T. DO WHILE .T. =esc_check() IF USED('SCXDATA') m.rec_count=RECCOUNT('SCXDATA') ENDIF IF .NOT.screenset m.platform_=ALLTRIM(m.platform_) DO CASE CASE EMPTY(m.platform_) IF m.allplatforms m.platform_=m.cplatform_ ELSE DO CASE CASE _WINDOWS m.platform_='WINDOWS' CASE _MAC m.platform_='MAC' CASE _UNIX m.platform_='UNIX' OTHERWISE m.platform_='DOS' ENDCASE ENDIF CASE .NOT._FOX25.OR..NOT.m.allplatforms EXIT CASE m.platform_==m.null m.platform_=m.splatform_ CASE .NOT.USED('SCXDATA') =.F. OTHERWISE DO CASE CASE m.platform_=='DOS' m.platform_='WINDOWS' CASE m.platform_=='WINDOWS' m.platform_='MAC' CASE m.platform_=='MAC' m.platform_='UNIX' CASE m.platform_=='UNIX'.AND..NOT.ALLTRIM(m.splatform_)=='DOS' m.platform_='DOS' OTHERWISE EXIT ENDCASE IF m.platform_==ALLTRIM(m.splatform_) EXIT ENDIF ENDCASE m.platform_=PADR(m.platform_,8) ENDIF IF .NOT.m.lib_mode.AND..NOT.EMPTY(m.msg1) m.msg2=SPACE(50) DO delaybar WITH m.msg1,m.msg2,.1,.F. ENDIF IF .NOT.m.allplatforms.OR.m.platform_==m.splatform_ m.name_mode=.F. SELECT PJXDATA IF .NOT.TYPE=='s' LOCATE FOR TYPE=='s' ENDIF IF EOF() EXIT ENDIF IF m.fromproj m.fscxbase=ALLTRIM(MLINE(NAME,1)) m.at_pos=RAT('\',m.projpath) IF m.at_pos>0.AND..NOT.LEFT(m.fscxbase,1)=='\'.AND.; .NOT.':'$m.fscxbase m.fscxbase=LEFT(m.projpath,m.at_pos)+m.fscxbase ELSE LOCATE m.fscxbase=FULLPATH(trimpath(m.fscxbase),HOMEDIR) IF .NOT.FILE(m.fscxbase) m.fscxbase=FULLPATH(trimpath(m.fscxbase),m.projpath) ENDIF ENDIF ELSE m.fscxbase=SUBSTR(FULLPATH(STRTRAN(ALLTRIM(MLINE(NAME,1)),'..\','')),3) IF .NOT.'\'$m.fscxbase LOCATE m.fscxbase=FULLPATH(m.fscxbase,NAME) ELSE IF .NOT.':'$m.fscxbase IF SUBSTR(m.fsprout,2,1)==':' m.fscxbase=LEFT(m.fsprout,2)+m.fscxbase ENDIF ENDIF IF .NOT.FILE(m.fscxbase) m.fscxbase=trimpath(m.fscxbase) IF .NOT.FILE(m.fscxbase) LOCATE m.fscxbase=FULLPATH(m.fscxbase,NAME) ENDIF ENDIF ENDIF ENDIF m.fscxbase=STRTRAN(m.fscxbase,m.null,'') IF EOF().OR..NOT.FILE(m.fscxbase) EXIT ENDIF IF USED('SCXBASE') SELECT SCXBASE USE ELSE SELECT 0 ENDIF USE (m.fscxbase) ALIAS SCXBASE AGAIN IF TYPE('PLATFORM')=='C' LOCATE FOR OBJTYPE=1.AND.PLATFORM==m.cplatform_ ELSE LOCATE FOR OBJTYPE=1 ENDIF IF EOF() IF TYPE('PLATFORM')#'C' EXIT ENDIF LOCATE FOR OBJTYPE=1.AND.PLATFORM==m.splatform_ IF EOF() LOCATE FOR OBJTYPE=1 IF EOF() EXIT ENDIF m.splatform_=PLATFORM m.platform_=m.null LOOP ENDIF ENDIF IF USED('FOXSCX') SELECT FOXSCX IF TYPE('PLATFORM')=='C' SET FILTER TO PLATFORM==m.platform_ ELSE SET FILTER TO ENDIF SET ORDER TO OBJNAME_ LOCATE IF USED('SCXDATA') SELECT SCXDATA ENDIF ENDIF m.setupcd=SETUPCODE m.setupcd=evltxt(m.setupcd) m.gsx_flag=(.NOT.SETUPCODE==m.setupcd) m.at_line=ATCLINE(m.c_noxgen,m.setupcd) IF m.at_line>0 m.memline=ALLTRIM(MLINE(m.setupcd,m.at_line)) m.at_pos=ATC(m.c_noxgen,m.memline) IF m.at_pos=1 m.xgen_mode=.F. EXIT ENDIF ENDIF IF m.platonly=='ON' m.setupcd='*:SET PLATONLY ON'+m.cr_lf+m.setupcd ENDIF m.j=0 FOR m.i = 1 TO 8 IF .NOT.EMPTY(a_fscxdrv(m.i)).OR.(m.i<=6.AND.; .NOT.EMPTY(a_fsprdrv(m.i))) m.j=1 EXIT ENDIF ENDFOR IF .NOT.m.gsx_flag.AND.m.j=0.AND..NOT.'*:'$m.setupcd.AND.; .NOT.'#:'$m.setupcd LOCATE FOR '*:'$COMMENT.OR.('{{'$COMMENT.AND.'}}'$COMMENT) IF EOF() EXIT ENDIF ENDIF m.msg1=PADR('Intializing Screen Database...',50) m.msg2=PADR(trimpath(STRTRAN(IIF(_WINDOWS,LOWER(m.fscxbase),; UPPER(m.fscxbase)),m.null,'')),50) DO delaybar WITH m.msg1,m.msg2,0,.T. m.scxcount=m.scxcount+1 FOR m.i = 1 TO 16 a_scxalias(m.i)=uniquefile() IF USED(a_scxalias(m.i)) USE IN (a_scxalias(m.i)) ENDIF ENDFOR m.fscxdata=FULLPATH(a_scxalias(m.scxcount),m.fscxbase) DIMENSION a_fscxdata(m.scxcount),a_scxupd(m.scxcount) a_fscxdata(m.scxcount)=m.fscxdata IF TYPE('PLATFORM')#'C' _FOX25=.F. ENDIF SELECT * FROM SCXBASE INTO TABLE (m.fscxdata) USE IF USED('SCXDATA') SELECT SCXDATA USE ELSE SELECT 0 ENDIF USE (m.fscxdata) ALIAS SCXDATA IF TYPE('PLATFORM')=='C' LOCATE FOR OBJTYPE=1.AND.PLATFORM==m.splatform_ ELSE LOCATE FOR OBJTYPE=1 ENDIF IF EOF() EXIT ENDIF IF m.scxcount>1 m.setupcd=SETUPCODE m.setupcd=evltxt(m.setupcd) ENDIF REPLACE SETUPCODE WITH m.setupcd m.setupcd='' m.rec_count=RECCOUNT() DO delaybar WITH '','',100,.F. m.msg1='' ENDIF IF .NOT.USED('SCXDATA') IF .NOT._FOX25 =warning("GENSCRNX could not be pre-processed file") EXIT ENDIF LOCATE IF EOF() EXIT ENDIF m.splatform_=ALLTRIM(m.splatform_) DO CASE CASE m.splatform_=='WINDOWS' m.splatform_='DOS' CASE m.splatform_=='MAC' m.splatform_='WINDOWS' CASE m.splatform_=='UNIX' m.splatform_='MAC' CASE m.splatform_=='DOS' m.splatform_='UNIX' OTHERWISE EXIT ENDCASE m.splatform_=PADR(m.splatform_,8) m.platform_=m.null LOOP ENDIF m.screenset=.F. SELECT SCXDATA IF TYPE('PLATFORM')=='C' SET FILTER TO PLATFORM==m.platform_.AND.OBJTYPE#2.AND.OBJTYPE#10 ELSE SET FILTER TO OBJTYPE#2.AND.OBJTYPE#10 ENDIF LOCATE IF EOF() LOOP ENDIF IF USED('FOXSCX') SELECT FOXSCX IF TYPE('PLATFORM')=='C' SET FILTER TO PLATFORM==m.platform_ ELSE SET FILTER TO ENDIF SET ORDER TO OBJNAME_ LOCATE SELECT SCXDATA ENDIF COUNT TO m.rec_total LOCATE FOR OBJTYPE#1 m.r_scxdata=IIF(EOF(),m.r_scxdata,RECNO()) LOCATE m.setupcd=SETUPCODE m.setupcd=evltxt(m.setupcd) LOCATE REPLACE SETUPCODE WITH evltxt(m.setupcd) m.setupcd='' SCATTER MEMVAR MEMO m.scx_name=trimpath(m.fscxbase,.T.) m.lib_name=m.scx_name m.newsetpath=m.lastsetpath+';'+FULLPATH(' ',m.fscxbase) SET PATH TO (m.newsetpath) a_inclib='' a_baslib='' DIMENSION a_inclib(1),a_baslib(1) m.inclibs=0 m.baslibs=0 m.memvarmode=.F. m.match_drv=.F. FOR m.i = 1 TO 8 a_scxdrvs(m.i)=a_scxdrvm(m.i) IF .NOT.m.loop_plat.AND.m.scxcount=1.AND.; .NOT.EMPTY(a_fscxdrv(m.i)).AND.ASCAN(a_scxdrv,a_fscxdrv(m.i))=0 IF FILE(a_fscxdrv(m.i)) m.match_drv=.T. a_scxdrvs(m.i)=a_scxdrvs(m.i)+1 a_scxdrvm(m.i)=a_scxdrvm(m.i)+1 a_scxdrv(a_scxdrvs(m.i),m.i)=a_fscxdrv(m.i) ELSE =warning(a_c_scxdrv(m.i),a_fscxdrv(m.i)) ENDIF ENDIF IF m.i>6 LOOP ENDIF a_sprdrvs(m.i)=a_sprdrvm(m.i) IF .NOT.m.loop_plat.AND.m.scxcount=1.AND.; .NOT.EMPTY(a_fsprdrv(m.i)).AND.; ASCAN(a_sprdrv,a_fsprdrv(m.i))=0 IF FILE(a_fsprdrv(m.i)) a_sprdrvs(m.i)=a_sprdrvs(m.i)+1 a_sprdrvm(m.i)=a_sprdrvm(m.i)+1 a_sprdrv(a_sprdrvs(m.i),m.i)=a_fsprdrv(m.i) ELSE =warning(a_c_sprdrv(m.i),a_fsprdrv(m.i)) ENDIF ENDIF ENDFOR m.loop_plat=.T. m.at_line=ATCLINE(a_c_scxdrv(1),SETUPCODE) IF m.at_line>0 m.i=m.at_line-1 DO WHILE m.i<MEMLINES(SETUPCODE) m.i=m.i+1 m.memline=ALLTRIM(MLINE(SETUPCODE,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,SETUPCODE,m.i)+1 IF m.at_pos=1.OR.ATC(a_c_scxdrv(1),SUBSTR(SETUPCODE,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(a_c_scxdrv(1),m.memline) IF m.at_pos=1 m.memline=add_fext(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(a_c_scxdrv(1))))) IF EMPTY(m.memline).OR..NOT.FILE(m.memline) =warning(a_c_scxdrv(1),m.memline) LOOP ENDIF a_scxdrvs(1)=a_scxdrvs(1)+1 DIMENSION a_scxdrv(a_scxdrvs(1),8) a_scxdrv(a_scxdrvs(1),1)=m.memline LOOP ENDIF ENDDO ENDIF IF a_scxdrvs(1)>0 m.drv_no=1 FOR m.i = 1 TO a_scxdrvs(1) SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,1)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF m.insscxs=0 m.at_line=ATCLINE('*:',SETUPCODE) IF m.at_line>0 m.i=m.at_line-1 DO WHILE m.i<MEMLINES(SETUPCODE) m.i=m.i+1 m.memline=ALLTRIM(MLINE(SETUPCODE,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,SETUPCODE,m.i)+1 IF m.at_pos=1.OR.ATC('*:',SUBSTR(SETUPCODE,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_noxgen,m.memline) IF m.at_pos=1 m.xgen_mode=.F. EXIT ENDIF FOR m.j = 2 TO 8 m.at_pos=ATC(a_c_scxdrv(m.j),m.memline) IF m.at_pos=1 m.memline=add_fext(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(a_c_scxdrv(m.j))))) IF EMPTY(m.memline).OR..NOT.FILE(m.memline) =warning(a_c_scxdrv(m.j),m.memline) LOOP ENDIF a_scxdrvs(m.j)=a_scxdrvs(m.j)+1 DIMENSION a_scxdrv(a_scxdrvs(m.j),8) a_scxdrv(a_scxdrvs(m.j),m.j)=m.memline LOOP ENDIF ENDFOR FOR m.j = 1 TO 6 m.at_pos=ATC(a_c_sprdrv(m.j),m.memline) IF m.at_pos=1 m.memline=add_fext(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(a_c_sprdrv(m.j))))) IF EMPTY(m.memline).OR..NOT.FILE(m.memline) =warning(a_c_sprdrv(m.j),m.memline) LOOP ENDIF a_sprdrvs(m.j)=a_sprdrvs(m.j)+1 DIMENSION a_sprdrv(a_sprdrvs(m.j),8) a_sprdrv(a_sprdrvs(m.j),m.j)=m.memline LOOP ENDIF ENDFOR m.at_pos=ATC(m.c_deflib,m.memline) IF m.at_pos=1 m.memline=ALLTRIM(UPPER(SUBSTR(m.memline,m.at_pos+LEN(m.c_deflib)))) IF EMPTY(m.memline) LOOP ENDIF m.lib_mode=.T. m.lib_name=m.memline REPLACE SETUPCODE WITH strtranc(SETUPCODE,m.c_deflib,m.m_deflib) ELSE m.at_pos=ATC(m.c_nogen,m.memline) ENDIF IF m.at_pos=1 IF .NOT.m.gen_mode LOOP ENDIF m.gen_mode=.F. IF m.fromproj.AND..NOT.m.screenend REPLACE COMMENT WITH '' COPY MEMO COMMENT TO (m.fsprout) ELSE IF FILE(m.fsprout) ERASE (m.fsprout) ENDIF ENDIF IF FILE(m.fspxout) ERASE (m.fspxout) ENDIF IF FILE(m.fsprerr) ERASE (m.fsprerr) ENDIF LOOP ENDIF m.at_pos=ATC(m.c_inclib,m.memline) IF m.at_pos=1 m.memline=CHRTRAN(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_inclib))),m.badchars,m.stdascii) IF EMPTY(m.memline) LOOP ENDIF m.inclibs=m.inclibs+1 DIMENSION a_inclib(m.inclibs) a_inclib(m.inclibs)=m.memline LOOP ENDIF m.at_pos=ATC(m.c_baslib,m.memline) IF m.at_pos=1 m.memline=CHRTRAN(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_baslib))),m.badchars,m.stdascii) IF EMPTY(m.memline) LOOP ENDIF m.baslibs=m.baslibs+1 DIMENSION a_baslib(m.baslibs) a_baslib(m.baslibs)=m.memline IF ASCAN(a_inclib,m.memline)=0 m.inclibs=m.inclibs+1 DIMENSION a_inclib(m.inclibs) a_inclib(m.inclibs)=m.memline ENDIF LOOP ENDIF m.at_pos=ATC(m.c_memvar,m.memline) IF m.at_pos=1 m.memvarmode=.T. LOOP ENDIF IF TYPE('PLATFORM')=='C' m.at_pos=ATC(m.c_name,m.memline) IF m.at_pos=1 m.name_mode=.T. LOOP ENDIF ENDIF m.at_pos=ATC(m.c_compspr,m.memline) IF m.at_pos=1 m.compspr='ON' LOOP ENDIF m.at_pos=ATC(m.c_nocompspr,m.memline) IF m.at_pos=1 m.compspr='OFF' LOOP ENDIF m.at_pos=ATC(m.c_dispspr,m.memline) IF m.at_pos=1 m.dispspr='ON' LOOP ENDIF m.at_pos=ATC(m.c_nodispspr,m.memline) IF m.at_pos=1 m.dispspr='OFF' LOOP ENDIF m.at_pos=ATC(m.c_autorun,m.memline) IF m.at_pos=1 m.autorun='ON' LOOP ENDIF m.at_pos=ATC(m.c_noautorun,m.memline) IF m.at_pos=1 m.autorun='OFF' LOOP ENDIF m.at_pos=ATC(m.c_pjxset,m.memline) IF m.at_pos=1 m.pjxset=.T. LOOP ENDIF m.at_pos=ATC(m.c_set,m.memline) IF m.at_pos=1 IF m.pjxset.AND.m.fromproj LOOP ENDIF m.memline=ALLTRIM(STRTRAN(SUBSTR(m.memline,m.at_pos+; LEN(m.c_set)),CHR(9),' ')) m.at_pos=AT(' ',m.memline) IF m.at_pos=0 LOOP ENDIF m.field_name='PJXDATA.'+ALLTRIM(UPPER(LEFT(m.memline,m.at_pos))) IF TYPE(m.field_name)=='U' m.field_name=STRTRAN(STRTRAN(m.field_name,'BORDERGETS','NOLOGO'),; 'PLATONLY','SAVECODE') IF TYPE(m.field_name)=='U' LOOP ENDIF ENDIF m.memline=ALLTRIM(UPPER(SUBSTR(m.memline,m.at_pos))) DO CASE CASE EMPTY(m.memline) LOOP CASE ATC('ASSOCWINDS',m.field_name)>0 m.at_pos=AT(' ',m.memline) IF m.at_pos=0 LOOP ENDIF IF .NOT.ALLTRIM(UPPER(LEFT(m.memline,m.at_pos)))=='TO' LOOP ENDIF m.memline=ALLTRIM(SUBSTR(m.memline,m.at_pos)) m.set_mode=STRTRAN(m.memline,',',CHR(13))+CHR(13) CASE m.memline=='ON' m.set_mode=.T. CASE m.memline=='OFF' m.set_mode=.F. OTHERWISE LOOP ENDCASE GOTO m.recno IN PJXDATA IF TYPE(m.field_name)=='M' REPLACE (m.field_name) WITH EVALUATE(m.field_name)+m.set_mode,; PJXDATA.MODAL WITH .T. ELSE REPLACE (m.field_name) WITH m.set_mode ENDIF LOOP ENDIF m.at_pos=ATC(m.c_prg,m.memline) IF m.at_pos=1 IF m.pjxset.AND.m.fromproj LOOP ENDIF m.at_pos=AT('.',m.fsprout) REPLACE SETUPCODE WITH '#NOREAD PLAIN'+m.cr_lf+SETUPCODE m.i=m.i+1 m.memline=m.c_outfile+' '+IIF(m.at_pos=0,m.fsprout,; LEFT(m.fsprout,m.at_pos-1))+'.PRG' ENDIF m.at_pos=ATC(m.c_outfile,m.memline) IF m.at_pos=1 m.memline=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_outfile))) m.at_pos=AT('.',m.memline) IF EMPTY(m.memline).OR.m.at_pos=0.OR.m.at_pos=LEN(m.memline) LOOP ENDIF GOTO m.recno IN PJXDATA IF ':'$m.memline.OR.'\'$m.memline m.fsprout=m.memline ELSE m.fsprout=FULLPATH(m.memline,m.fscxbase) ENDIF m.file_ext=UPPER(RIGHT(m.fsprout,4)) DO CASE CASE m.file_ext=='.SPR' m.file_ext='.SPX' CASE m.file_ext=='.MPR' m.file_ext='.MPX' OTHERWISE m.file_ext='.FXP' ENDCASE m.fspxout=trimext(m.fsprout)+m.file_ext m.fsprerr=trimext(m.fsprout)+'.ERR' REPLACE PJXDATA.OUTFILE WITH m.fsprout+m.null m.winrelease=trimpath(m.fsprerr) IF WEXIST(m.winrelease) RELEASE WINDOW (m.winrelease) ENDIF IF FILE(m.fsprerr) ERASE (m.fsprerr) ENDIF IF FILE(m.fspxout) ERASE (m.fspxout) ENDIF m.winrelease=trimpath(m.fsprout) IF WEXIST(m.winrelease) RELEASE WINDOW (m.winrelease) ENDIF IF FILE(m.fsprout) ERASE (m.fsprout) ENDIF LOOP ENDIF m.at_pos=ATC(m.c_genscrnx,m.memline) IF m.at_pos=1 m.memline=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_genscrnx))) IF EMPTY(m.memline) LOOP ENDIF IF ':'$m.memline.OR.'\'$m.memline m.genscrn=m.memline ELSE m.genscrn=FULLPATH(m.memline,SYS(2004)) ENDIF IF .NOT.'.'$RIGHT(m.genscrn,4) m.genscrn=m.genscrn+'.PRG' ENDIF LOOP ENDIF ENDDO ENDIF IF .NOT.m.xgen_mode EXIT ENDIF SELECT SCXDATA LOCATE IF EMPTY(m.msg1) m.comp_flag=.T. DO CASE CASE m.gen_mode IF _WINDOWS SET MESSAGE TO PADR('Generating Screen Database: '+LOWER(m.fscxbase),79) ENDIF m.msg1=PADR('Generating Screen Database...',50) CASE m.lib_mode IF _WINDOWS SET MESSAGE TO PADR('Updating Library Database: '+LOWER(m.fscxbase),79) ENDIF m.msg1=PADR('Updating Library Database...',50) OTHERWISE IF _WINDOWS SET MESSAGE TO PADR('Scanning Screen Database: '+LOWER(m.fscxbase),79) ENDIF m.msg1=PADR('Scanning Screen Database...',50) ENDCASE m.msg2=PADR(IIF(m.gen_mode,'['+ALLTRIM(m.platform_)+']',''),50) DO delaybar WITH m.msg1,m.msg2,.1,.F. ELSE m.msg2=PADR(IIF(m.gen_mode,'['+ALLTRIM(m.platform_)+']',''),50) ENDIF DO esc_check GOTO m.recno IN PJXDATA IF .NOT.openfoxscx() EXIT ENDIF SELECT FOXSCX IF TYPE('PLATFORM')=='C' SET FILTER TO PLATFORM==m.platform_ ELSE SET FILTER TO ENDIF SET ORDER TO OBJSCX_ LOCATE m.scx_name=PADR(m.scx_name,LEN(OBJSCX_)) m.lib_name=PADR(m.lib_name,LEN(OBJLIB_)) SEEK m.scx_name+m.lib_name REPLACE REST OBJFLAG_ WITH .F.; WHILE OBJSCX_==m.scx_name.AND.OBJLIB_==m.lib_name LOCATE SELECT SCXDATA LOCATE m.setupcd=SETUPCODE REPLACE SETUPCODE WITH evltxt(m.setupcd) m.setupcd='' IF ATC(m.c_defobj,SETUPCODE)>0.OR.ATC(m.c_basobj,SETUPCODE)>0 REPLACE COMMENT WITH SETUPCODE ENDIF m.lastfilter=FILTER() m.lib_upd=.F. m.loop_flag=.F. m.loop_def=.F. DO delaybar WITH '','',5,.F. DO WHILE .T. DO esc_check m.loop_obj=.F. SCAN ALL FOR .NOT.DELETED() IF .NOT.EMPTY(wordsearch(m.c_delete)) LOOP ENDIF =delrec() REPLACE COMMENT WITH strtranc(COMMENT,m.c_delete,m.m_delete) ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF m.match_drv=.F. IF m.gen_mode.AND..NOT.m.loop_flag.AND.a_scxdrvs(2)>0 GOTO m.r_scxdata REPLACE REST SETUPCODE WITH COMMENT; FOR OBJTYPE#1.AND..NOT.DELETED().AND..NOT.EMPTY(COMMENT) m.drv_no=2 FOR m.i = 1 TO a_scxdrvs(2) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,2),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(2)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,2)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,5,.F. ENDIF m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(3)>0 m.drv_no=3 FOR m.i = 1 TO a_scxdrvs(3) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,3),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(3)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,3)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,5,.F. ENDIF IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata REPLACE REST COMMENT WITH SETUPCODE, SETUPCODE WITH ''; FOR OBJTYPE#1.AND..NOT.DELETED().AND..NOT.EMPTY(SETUPCODE) GOTO m.r_scxdata m.obj_name=SPACE(LEN(FOXSCX.OBJNAME_)) m.obj_base=SPACE(LEN(FOXSCX.OBJBASE_)) m.obj_field=SPACE(LEN(FOXSCX.OBJFIELD_)) m.obj_lib=SPACE(LEN(FOXSCX.OBJLIB_)) SCAN ALL FOR .NOT.DELETED() m.obj_name=SPACE(LEN(FOXSCX.OBJNAME_)) m.obj_base=SPACE(LEN(FOXSCX.OBJBASE_)) m.obj_field=SPACE(LEN(FOXSCX.OBJFIELD_)) m.obj_lib=SPACE(LEN(FOXSCX.OBJLIB_)) IF m.memvarmode m.old_text=ALLTRIM(MLINE(NAME,1)) m.at_pos=AT('.',m.old_text) m.new_text='m'+SUBSTR(m.old_text,m.at_pos) IF m.at_pos>0.AND.(m.at_pos#2.OR.; .NOT.UPPER(LEFT(m.old_text,2))=='M.').AND.; .NOT.m.old_text==m.new_text REPLACE NAME WITH m.new_text,; WHEN WITH strtranc(WHEN,m.old_text,m.new_text),; VALID WITH strtranc(VALID,m.old_text,m.new_text),; MESSAGE WITH strtranc(MESSAGE,m.old_text,m.new_text),; ERROR WITH strtranc(ERROR,m.old_text,m.new_text),; RANGELO WITH strtranc(RANGELO,m.old_text,m.new_text),; RANGEHI WITH strtranc(RANGEHI,m.old_text,m.new_text) ENDIF ENDIF IF m.lib_mode.AND..NOT.m.loop_flag.AND.ATC(m.c_defobj,COMMENT)>0 m.at_line=ATCLINE(m.c_defobj,COMMENT) IF m.at_line>0 FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_defobj,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_defobj,m.memline) IF m.at_pos=1 m.obj_name=PADR(CHRTRAN(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_defobj))),m.badchars,m.stdascii),; LEN(FOXSCX.OBJNAME_)) EXIT ENDIF ENDFOR ENDIF ENDIF m.at_line=ATCLINE(m.c_basobj,COMMENT) IF m.at_line>0 FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_basobj,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_basobj,m.memline) IF m.at_pos=1 m.obj_base=PADR(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_basobj))),LEN(FOXSCX.OBJBASE_)) EXIT ENDIF ENDFOR ENDIF IF OBJTYPE>=11 m.obj_field=MLINE(NAME,1) m.obj_field=PADR(ALLTRIM(UPPER(SUBSTR(m.obj_field,AT('.',; m.obj_field)+1))),LEN(FOXSCX.OBJFIELD_)) IF m.baslibs>0.AND..NOT.EMPTY(m.obj_field) m.r=RECNO() SELECT FOXSCX SET ORDER TO OBJFIELD_ m.lastexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO m.baslibs SEEK PADR(m.obj_field,LEN(OBJFIELD_))+; PADR(a_baslib(m.i),LEN(OBJLIB_)) IF .NOT.EOF() m.obj_base=OBJNAME_ m.obj_lib=OBJLIB_ EXIT ENDIF ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF SELECT SCXDATA GOTO m.r IF EMPTY(m.obj_base).OR.ATC(m.m_basobj,COMMENT)>0.OR.; EMPTY(wordsearch(m.c_basobj)) LOOP ENDIF REPLACE COMMENT WITH m.c_basobj+' '+m.obj_base+m.cr_lf+COMMENT ENDIF ENDIF IF .NOT.m.lib_mode.OR.EMPTY(m.obj_name) LOOP ENDIF m.lib_upd=.T. m.i=m.r_scxdata-2 m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+ALLTRIM(m.lib_name)+'.'+; m.obj_name,50) DO delaybar WITH '',m.msg3,90*(RECNO()-m.i)/m.rec_total+5,.F. IF ATC(m.c_defobj,SETUPCODE)>0 REPLACE SETUPCODE WITH strtranc(SETUPCODE,m.c_defobj,m.m_defobj) ENDIF REPLACE COMMENT WITH strtranc(COMMENT,m.c_defobj,m.m_defobj) DIMENSION a_fields(1) =AFIELDS(a_fields) RELEASE a_scatter SCATTER TO a_scatter MEMO SELECT FOXSCX SET ORDER TO OBJNAME_ SEEK UPPER(m.obj_name+m.lib_name) IF EOF() INSERT BLANK ENDIF IF ALEN(a_scatter)=(FCOUNT()-m.fcountadj) GATHER FROM a_scatter MEMO ELSE m.lastexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO (FCOUNT()-m.fcountadj) m.j=ASCAN(a_fields,FIELD(m.i)) IF m.j=0 LOOP ENDIF REPLACE (FIELD(m.i)) WITH a_scatter(INT(m.j/4)+1) ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ENDIF REPLACE PLATFORM WITH m.platform_, OBJNAME_ WITH m.obj_name,; OBJBASE_ WITH m.obj_base, OBJFIELD_ WITH m.obj_field,; OBJLIB_ WITH m.lib_name, OBJSCX_ WITH m.scx_name,; OBJFLAG_ WITH .T. SELECT SCXDATA ENDSCAN SELECT SCXDATA IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata IF .NOT.m.gen_mode EXIT ENDIF IF m.lib_upd.AND..NOT.m.loop_def DO delaybar WITH '',m.msg2,5,.F. ENDIF m.loop_def=.T. GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.at_pos=ATC(m.c_trntxt,COMMENT) IF m.at_pos=0 LOOP ENDIF m.str_data=SUBSTR(COMMENT,m.at_pos) FOR m.i = 1 TO MEMLINES(m.str_data) m.memline=ALLTRIM(MLINE(m.str_data,m.i)) m.at_pos=ATC(m.c_trntxt,m.memline) IF m.at_pos=1 m.at_pos=AT('||',m.memline) IF m.at_pos=0 LOOP ENDIF m.old_text=ALLTRIM(SUBSTR(m.memline,LEN(m.c_trntxt)+1,m.at_pos-; LEN(m.c_trntxt)-1)) IF LEN(m.old_text)=0 LOOP ENDIF m.old_text=STRTRAN(STRTRAN(STRTRAN(STRTRAN(m.old_text,'\\',; '\'),'\t',CHR(9)),'\n',CHR(10)),'\r',CHR(13)) m.at_pos2=AT('||',m.memline,2) m.new_text=ALLTRIM(SUBSTR(m.memline,m.at_pos+2,; IIF(m.at_pos2=0,LEN(m.memline),m.at_pos2-m.at_pos-2))) m.new_text=STRTRAN(STRTRAN(STRTRAN(STRTRAN(m.new_text,'\\',; '\'),'\t',CHR(9)),'\n',CHR(10)),'\r',CHR(13)) m.match_pos=.F. m.match_no=.F. IF m.at_pos2>0 m.at_pos=AT('||',m.memline,3) m.match_pos=VAL(SUBSTR(m.memline,m.at_pos2+2,; IIF(m.at_pos=0,LEN(m.memline),m.at_pos-m.at_pos2-2))) IF m.at_pos>0 m.match_no=VAL(SUBSTR(m.memline,m.at_pos+2)) ENDIF ENDIF FOR m.j = 1 TO FCOUNT() m.field_name=FIELD(m.j) IF TYPE(m.field_name)#'M' LOOP ENDIF m.field_eval=EVALUATE(m.field_name) IF m.field_name=='COMMENT' m.at_pos=OCCURS('||',m.field_eval) IF m.at_pos>0 m.at_pos=AT('||',m.field_eval,m.at_pos) IF m.at_pos>0 REPLACE (m.field_name) WITH LEFT(m.field_eval,m.at_pos-1)+; strtranc(SUBSTR(m.field_eval,m.at_pos),m.old_text,; m.new_text,m.match_pos,m.match_no) ENDIF ENDIF LOOP ENDIF IF ATC(m.old_text,m.field_eval)>0 REPLACE (m.field_name) WITH strtranc(m.field_eval,m.old_text,; m.new_text,m.match_pos,m.match_no) ENDIF ENDFOR ENDIF ENDFOR ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF SCAN ALL FOR .NOT.DELETED() IF evlrec() m.loop_obj=.T. ENDIF ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.at_line=ATCLINE(m.c_if,COMMENT) IF m.at_line=0 LOOP ENDIF FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_if,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_if,m.memline) IF m.at_pos=1 m.obj_expr=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_if))) IF EMPTY(m.obj_expr) LOOP ENDIF =insif2(m.obj_expr) REPLACE COMMENT WITH strtranc(COMMENT,m.c_if,m.m_if) EXIT ENDIF ENDFOR ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.at_line=ATCLINE(m.c_insobj,COMMENT) IF m.at_line=0 LOOP ENDIF FOR m.i = MEMLINES(COMMENT) TO m.at_line STEP -1 =esc_check() m.memline=ALLTRIM(UPPER(MLINE(COMMENT,m.i))) m.at_pos=ATC(m.c_insobj,m.memline) IF m.at_pos=1 m.obj_lib='' m.obj_name=PADR(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_insobj))),LEN(FOXSCX.OBJNAME_)) m.at_pos=AT('.',m.obj_name) IF m.at_pos>0 m.obj_lib=PADR(UPPER(CHRTRAN(ALLTRIM(LEFT(m.obj_name,m.at_pos-1)),; m.badchars,m.stdascii)),LEN(FOXSCX.OBJLIB_)) m.obj_name=ALLTRIM(SUBSTR(m.obj_name,m.at_pos+1)) ENDIF m.obj_name=PADR(CHRTRAN(m.obj_name,m.badchars,m.stdascii),; LEN(FOXSCX.OBJNAME_)) IF m.inclibs>0.AND.EMPTY(m.obj_lib) SELECT FOXSCX SET ORDER TO OBJNAME_ m.lastexac=SET('EXACT') SET EXACT ON FOR m.j = 1 TO m.inclibs SEEK UPPER(PADR(m.obj_name,LEN(OBJNAME_))+; PADR(a_inclib(m.j),LEN(OBJLIB_))) IF .NOT.EOF() m.obj_lib=OBJLIB_ EXIT ENDIF ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF SELECT SCXDATA ENDIF IF insobj(ALLTRIM(m.obj_lib)+'.'+ALLTRIM(m.obj_name)) m.loop_obj=.T. ENDIF ENDIF ENDFOR ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.at_line=ATCLINE(m.c_insscx,COMMENT) IF m.at_line=0 LOOP ENDIF FOR m.i = MEMLINES(COMMENT) TO m.at_line STEP -1 =esc_check() m.memline=ALLTRIM(MLINE(COMMENT,m.i)) m.at_pos=ATC(m.c_insscx,m.memline) IF m.at_pos=1 m.scx_file=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_insscx))) DO CASE CASE m.insscxs>=256 =delrec() CASE insscx(m.scx_file) m.loop_obj=.T. m.insscxs=m.insscxs+1 OTHERWISE m.memline=m.scx_file IF .NOT.'.'$m.memline m.memline=m.memline+'.SCX' ENDIF ENDCASE ENDIF ENDFOR ENDSCAN m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(4)>0 m.drv_no=4 FOR m.i = 1 TO a_scxdrvs(4) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,4),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(4)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,4)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,5,.F. ENDIF IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata SCAN REST FOR (OBJTYPE=5.OR.BETWEEN(OBJTYPE,11,22)).AND..NOT.DELETED() IF ATC(m.c_size,COMMENT)=0.AND.ATC(m.c_nosize,COMMENT)=0) LOOP ENDIF FOR m.i = 1 TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) m.at_pos=ATC(m.c_size,m.memline) IF m.at_pos=1 m.obj_expr=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_size))) IF EMPTY(m.obj_expr) LOOP ENDIF REPLACE SHOW WITH 'SIZE '+m.obj_expr, HEIGHT WITH m.scxcount+; IIF(OBJTYPE#15.OR.OBJCODE#2,-100,800),; WIDTH WITH RECNO()+256, SPACING WITH 0 a_scxupd(m.scxcount)='*' REPLACE COMMENT WITH strtranc(COMMENT,m.c_size,m.m_size) EXIT ELSE m.at_pos=ATC(m.c_nosize,m.memline) IF m.at_pos=1 IF OBJTYPE#15.OR.OBJCODE#2 REPLACE SHOW WITH '', HEIGHT WITH m.scxcount-100,; WIDTH WITH RECNO()+256, SPACING WITH 0 a_scxupd(m.scxcount)='*' REPLACE COMMENT WITH strtranc(COMMENT,m.c_nosize,m.m_nosize) ENDIF EXIT ENDIF ENDIF ENDFOR ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata SCAN REST FOR BETWEEN(OBJTYPE,11,22).AND..NOT.DELETED() m.at_line=ATCLINE(m.c_default,COMMENT) IF m.at_line=0 LOOP ENDIF FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_default,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_default,m.memline) IF m.at_pos=1 m.obj_expr=ALLTRIM(SUBSTR(m.memline,m.at_pos+LEN(m.c_default))) IF EMPTY(m.obj_expr) LOOP ENDIF DO CASE CASE BETWEEN(OBJTYPE,12,14) REPLACE INITIALNUM WITH VAL(m.obj_expr) CASE OBJTYPE#11.AND.OBJTYPE#20 REPLACE INITIALVAL WITH m.obj_expr ENDCASE REPLACE COMMENT WITH strtranc(COMMENT,m.c_default,m.m_default) EXIT ENDIF ENDFOR ENDSCAN m.obj_name=SPACE(LEN(FOXSCX.OBJNAME_)) m.obj_base=SPACE(LEN(FOXSCX.OBJBASE_)) SCAN ALL FOR .NOT.DELETED() RELEASE a_basobj DIMENSION a_basobj(1) m.basobjs=0 m.at_line=1 DO WHILE .T. m.at_line=ATCLINE(m.c_basobj,COMMENT) IF .NOT.BETWEEN(m.at_line,1,MEMLINES(COMMENT)) EXIT ENDIF m.obj_lib='' m.obj_base=SPACE(LEN(FOXSCX.OBJBASE_)) FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_basobj,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_basobj,m.memline) IF m.at_pos=0 LOOP ENDIF REPLACE COMMENT WITH strtranc(COMMENT,m.c_basobj,m.m_basobj,1,1) IF m.at_pos=1 m.obj_base=PADR(ALLTRIM(SUBSTR(m.memline,m.at_pos+; LEN(m.c_basobj))),LEN(FOXSCX.OBJBASE_)) m.at_pos=AT('.',m.obj_base) IF m.at_pos>0 m.obj_lib=PADR(UPPER(CHRTRAN(ALLTRIM(LEFT(m.obj_base,m.at_pos-1)),; m.badchars,m.stdascii)),LEN(FOXSCX.OBJLIB_)) m.obj_base=ALLTRIM(SUBSTR(m.obj_base,m.at_pos+1)) ENDIF m.obj_base=PADR(CHRTRAN(m.obj_base,m.badchars,m.stdascii),; LEN(FOXSCX.OBJBASE_)-LEN(FOXSCX.OBJLIB_)-1) EXIT ENDIF ENDFOR IF EMPTY(m.obj_base) LOOP ENDIF m.match=.F. m.r=RECNO() RELEASE a_fields DIMENSION a_fields(1) =AFIELDS(a_fields) RELEASE a_scatter SCATTER TO a_scatter MEMO SELECT FOXSCX SET ORDER TO OBJNAME_ IF m.inclibs=0.AND.EMPTY(m.obj_lib) =warning(m.c_basobj,m.obj_base) LOOP ENDIF RELEASE a_size,a_pict DO WHILE .NOT.EMPTY(m.obj_base).AND.(m.inclibs>0.OR.; .NOT.EMPTY(m.obj_lib)) DO esc_check m.j=0 m.at_pos=AT('.',m.obj_base) IF m.at_pos>0 m.obj_lib=PADR(UPPER(ALLTRIM(LEFT(m.obj_base,m.at_pos-1))),; LEN(FOXSCX.OBJLIB_)) m.obj_base=ALLTRIM(SUBSTR(m.obj_base,m.at_pos+1)) ENDIF m.obj_base=PADR(m.obj_base,LEN(FOXSCX.OBJBASE_)-; LEN(FOXSCX.OBJLIB_)-1) IF EMPTY(m.obj_lib) m.lastexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO m.inclibs SEEK UPPER(PADR(m.obj_base,LEN(OBJNAME_))+PADR(a_inclib(m.i),; LEN(OBJLIB_))) IF .NOT.EOF() m.j=RECNO() m.obj_lib=OBJLIB_ m.obj_base=OBJBASE_ EXIT ENDIF ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ELSE SEEK UPPER(m.obj_base+m.obj_lib) IF .NOT.EOF() m.j=RECNO() m.obj_base=OBJBASE_ ENDIF ENDIF IF m.j=0.OR.(UPPER(OBJNAME_)==PADR(m.obj_base,LEN(OBJNAME_)).AND.; (OBJLIB_==m.obj_lib.OR.EMPTY(m.obj_lib))) =warning(m.c_basobj,m.obj_lib+'.'+m.obj_base) m.obj_lib='' m.obj_base=SPACE(LEN(OBJBASE_)) EXIT ENDIF IF m.basobjs>0.AND.ASCAN(a_basobj,OBJLIB_+'.'+UPPER(OBJNAME_))>0 m.obj_lib='' m.obj_base=SPACE(LEN(OBJBASE_)) EXIT ENDIF m.j=RECCOUNT('SCXDATA') IF m.rec_count#m.j m.rec_total=m.rec_total+(m.j-m.rec_count) m.rec_count=m.j ENDIF m.i=m.r_scxdata-2 m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+ALLTRIM(OBJLIB_)+'.'+; OBJNAME_,50) DO delaybar WITH '',m.msg3,85*(RECNO('SCXDATA')-m.i)/m.rec_total+10,.F. m.basobjs=m.basobjs+1 DIMENSION a_basobj(m.basobjs) a_basobj(m.basobjs)=OBJLIB_+'.'+UPPER(OBJNAME_) m.basbefore=.F. m.old_text='' m.new_text='' FOR m.i = 1 TO ALEN(a_scatter) IF ALEN(a_scatter)=(FCOUNT()-m.fcountadj) m.j=m.i ELSE m.j=0 FOR m.k = 1 TO (FCOUNT()-m.fcountadj) IF FIELD(m.k)==a_fields(4*m.i-3) m.j=m.k EXIT ENDIF ENDFOR ENDIF m.field_name=FIELD(m.j) IF m.field_name=='NAME' m.old_text=NAME m.new_text=a_scatter(m.i) ENDIF m.field_type=TYPE(FIELD(m.j)) m.snpttype=-1 IF m.i>6 IF ATC('TYPE',FIELD(m.j-1))>0.AND.; .NOT.EMPTY(a_scatter(m.i)) m.snpttype=a_scatter(m.i-1) ENDIF IF RIGHT(m.field_name,4)=='BLUE' m.field_eval=EVALUATE(m.field_name) IF m.field_eval#-1.AND.a_scatter(m.i)=-1.AND.; a_scatter(m.i-1)=-1.AND.a_scatter(m.i-2)=-1 a_scatter(m.i)=m.field_eval a_scatter(m.i-1)=EVALUATE(FIELD(m.j-1)) a_scatter(m.i-2)=EVALUATE(FIELD(m.j-2)) ENDIF LOOP ENDIF IF SCXDATA.OBJTYPE=1.AND.SCXDATA.STYLE>1.AND.; INLIST(m.field_name,'SCHEME','SCHEME2','FLOAT','CLOSE',; 'MINIMIZE','BORDER','SHADOW') LOOP ENDIF IF 'PEN'$m.field_name.OR.'FILL'$m.field_name LOOP ENDIF IF LEFT(m.field_name,4)=='FONT' IF m.field_name=='FONTSIZE'.AND.a_scatter(m.i)=8.AND.; a_scatter(m.i-1)<=1.AND.; a_scatter(m.i-2)=='MS Sans Serif' a_scatter(m.i)=EVALUATE(m.field_name) a_scatter(m.i-1)=EVALUATE(FIELD(m.j-1)) a_scatter(m.i-2)=EVALUATE(FIELD(m.j-2)) ENDIF LOOP ENDIF IF 'FONT'$m.field_name LOOP ENDIF ENDIF IF (EMPTY(a_scatter(m.i)).OR.m.snpttype#-1.OR.; m.field_type=='L'.OR.(FIELD(m.j)=='COMMENT'.AND.; ATC(m.c_instxt,a_scatter(m.i))=0)).AND.; ATC('TYPE',FIELD(m.j))=0.AND.; .NOT.INLIST(FIELD(m.j),'VPOS','HPOS','HEIGHT','WIDTH').AND.; (RECNO()>=m.r_scxdata.OR..NOT.INLIST(FIELD(m.j),'STYLE',; 'ORDER','UNIQUE','ENVIRON','TAG','TAG2')) m.match=.T. IF m.i>6.AND.ATC('TYPE',FIELD(m.j-1))>0.AND.; .NOT.EMPTY(EVALUATE(FIELD(m.j))) a_scatter(m.i-1)=EVALUATE(FIELD(m.j-1)) ENDIF m.field_eval=EVALUATE(m.field_name) IF m.i>5.AND.m.snpttype#-1.AND..NOT.EMPTY(m.field_eval).AND.; m.snpttype#EVALUATE(FIELD(m.j-1)) SELECT SCXDATA m.r2=RECNO() LOCATE m.memline=SYS(2015) IF m.snpttype=1 REPLACE PROCCODE WITH PROCCODE+m.cr_lf+; 'FUNCTION '+m.memline+m.cr+lf+m.cr+lf+; a_scatter(m.i)+m.cr_lf a_scatter(m.i)=m.memline+'()' ELSE REPLACE PROCCODE WITH PROCCODE+m.cr_lf+; 'FUNCTION '+m.memline+m.cr+lf+m.cr+lf+; m.field_eval+m.cr_lf m.field_eval=m.memline+'()' ENDIF GOTO m.r2 SELECT FOXSCX a_scatter(m.i-1)=0 m.snpttype=0 ENDIF DO CASE CASE EMPTY(m.field_eval) =.F. CASE (m.snpttype=-1.OR..NOT.m.field_type=='M').AND.; .NOT.FIELD(m.j)=='COMMENT' a_scatter(m.i)=m.field_eval CASE m.snpttype=0.AND..NOT.FIELD(m.j)=='COMMENT' IF LEFT(FIELD(m.j),5)=='RANGE' =.F. ELSE m.field_eval=STRTRAN(STRTRAN(ALLTRIM(m.field_eval),; m.cr,''),m.lf,'') a_scatter(m.i)=STRTRAN(STRTRAN(ALLTRIM(a_scatter(m.i)),; m.cr,''),m.lf,'') DO CASE CASE LEFT(m.field_eval,7)=='.T..OR.'.OR.; LEFT(m.field_eval,7)=='.T. OR ' m.str_data=a_scatter(m.i) m.str_data2=').OR.(' m.str_data3=SUBSTR(m.field_eval,8) CASE RIGHT(m.field_eval,7)=='.OR..T.'.OR.; RIGHT(m.field_eval,7)==' OR .T.' m.str_data=a_scatter(m.i) m.str_data2=').OR.(' m.str_data3=LEFT(m.field_eval,LEN(m.field_eval)-7) CASE LEFT(a_scatter(m.i),7)=='.T..OR.'.OR.; LEFT(a_scatter(m.i),7)=='.T. OR ' m.str_data=SUBSTR(a_scatter(m.i),8) m.str_data2=').OR.(' m.str_data3=m.field_eval CASE RIGHT(a_scatter(m.i),7)=='.OR..T.'.OR.; RIGHT(a_scatter(m.i),7)==' OR .T.' m.str_data=LEFT(a_scatter(m.i),LEN(a_scatter(m.i))-7) m.str_data2=').OR.(' m.str_data3=m.field_eval OTHERWISE m.str_data=a_scatter(m.i) m.str_data2=').AND.(' m.str_data3=m.field_eval ENDCASE IF m.basbefore a_scatter(m.i)='('+m.str_data3+m.str_data2+; m.str_data+')' ELSE a_scatter(m.i)='('+m.str_data+m.str_data2+; m.str_data3+')' ENDIF ENDIF OTHERWISE SELECT SCXDATA IF m.basbefore.AND..NOT.FIELD(m.j)=='COMMENT' IF .NOT.RIGHT(m.field_eval,2)==m.cr_lf m.field_eval=m.field_eval+m.cr_lf ENDIF a_scatter(m.i)=m.field_eval+a_scatter(m.i) ELSE IF .NOT.RIGHT(a_scatter(m.i),2)==m.cr_lf a_scatter(m.i)=a_scatter(m.i)+m.cr_lf ENDIF a_scatter(m.i)=a_scatter(m.i)+m.field_eval ENDIF SELECT FOXSCX ENDCASE DO CASE CASE FIELD(m.j)=='COMMENT' SELECT SCXDATA REPLACE COMMENT WITH a_scatter(m.i) IF .NOT.wordsearch(m.c_basbefore)==m.null m.basbefore=.T. REPLACE COMMENT WITH strtranc(COMMENT,m.c_basbefore,; m.m_basbefore) a_scatter(m.i)=COMMENT ENDIF IF .NOT.wordsearch(m.c_svsize)==m.null RELEASE a_size DIMENSION a_size(4) a_size(1)=FOXSCX.HEIGHT a_size(2)=FOXSCX.WIDTH a_size(3)=FOXSCX.INITIALNUM a_size(4)=FOXSCX.SPACING REPLACE COMMENT WITH strtranc(COMMENT,m.c_svsize,; m.m_svsize) a_scatter(m.i)=COMMENT ENDIF IF .NOT.wordsearch(m.c_svpict)==m.null RELEASE a_pict DIMENSION a_pict(3) a_pict(1)=FOXSCX.PICTURE a_pict(2)=FOXSCX.INITIALVAL a_pict(3)=STR(FOXSCX.INITIALNUM,9,3) REPLACE COMMENT WITH strtranc(COMMENT,m.c_svpict,; m.m_svpict) a_scatter(m.i)=COMMENT ENDIF m.loop_obj=.T. SELECT FOXSCX CASE m.field_type=='M'.AND..NOT.EMPTY(m.new_text).AND.; .NOT.m.old_text==m.new_text a_scatter(m.i)=strtranc(a_scatter(m.i),m.old_text,; m.new_text) ENDCASE ENDIF ENDFOR ENDDO SELECT SCXDATA GOTO m.r IF m.match GATHER FROM a_scatter MEMO IF TYPE('a_size')=='N' REPLACE HEIGHT WITH a_size(1) REPLACE WIDTH WITH a_size(2) IF OBJTYPE=15 REPLACE INITIALNUM WITH a_size(3) ENDIF REPLACE SPACING WITH a_size(4) ENDIF IF TYPE('a_pict')=='C' REPLACE PICTURE WITH a_pict(1) IF BETWEEN(OBJTYPE,12,14) REPLACE INITIALVAL WITH a_pict(2) REPLACE INITIALNUM WITH VAL(a_pict(3)) ENDIF ENDIF RELEASE a_size,a_pict =evlrec() ENDIF ENDDO ENDSCAN m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(5)>0 m.drv_no=5 FOR m.i = 1 TO a_scxdrvs(5) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,5),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(5)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,5)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,5,.F. ENDIF IF .NOT.m.loop_obj EXIT ENDIF IF .NOT.m.loop_flag m.loop_flag=.T. m.setfilter='(DEACTTYPE<=1.OR.OBJTYPE=1)' IF .NOT.EMPTY(m.lastfilter) m.setfilter=m.lastfilter+'.AND.'+m.setfilter ENDIF LOCATE ENDIF SCAN ALL FOR .NOT.DELETED() DO CASE CASE RECNO()<m.r_scxdata IF DEACTTYPE<=1 REPLACE ACTIVTYPE WITH ACTIVTYPE+2, DEACTTYPE WITH DEACTTYPE+2 ENDIF CASE ACTIVTYPE=2 REPLACE ACTIVTYPE WITH 0, DEACTTYPE WITH 0 CASE ATC(m.c_basobj,COMMENT)=0.AND.ATC(m.c_insobj,COMMENT)=0.AND.; ATC(m.c_insscx,COMMENT)=0.AND.ATC(m.c_trntxt,COMMENT)=0.AND.; ATC(m.c_if,COMMENT)=0.AND.ATC(m.c_size,COMMENT)=0.AND.; ATC(m.c_nosize,COMMENT)=0.AND.ATC(m.c_default,COMMENT)=0 REPLACE DEACTTYPE WITH 2 ENDCASE ENDSCAN SET FILTER TO &setfilter LOCATE IF EOF() EXIT ENDIF m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(6)>0 m.drv_no=6 FOR m.i = 1 TO a_scxdrvs(6) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,6),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(6)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,6)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,5,.F. ENDIF ENDDO IF m.gen_mode DO delaybar WITH '',m.msg2,95,.F. ENDIF IF m.loop_flag IF EMPTY(m.lastfilter) SET FILTER TO ELSE SET FILTER TO &lastfilter ENDIF REPLACE ALL ACTIVTYPE WITH MAX(ACTIVTYPE-2,0),; DEACTTYPE WITH MAX(DEACTTYPE-2,0) ENDIF SCAN ALL FOR .NOT.DELETED() IF .NOT.EMPTY(wordsearch(m.c_delete)) LOOP ENDIF =delrec() REPLACE COMMENT WITH strtranc(COMMENT,m.c_delete,m.m_delete) ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF IF m.gen_mode GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.at_pos=ATC(m.c_trntxt,COMMENT) IF m.at_pos=0 LOOP ENDIF m.str_data=SUBSTR(COMMENT,m.at_pos) FOR m.i = 1 TO MEMLINES(m.str_data) m.memline=ALLTRIM(MLINE(m.str_data,m.i)) m.at_pos=ATC(m.c_trntxt,m.memline) IF m.at_pos=1 m.at_pos=AT('||',m.memline) IF m.at_pos=0 LOOP ENDIF m.old_text=ALLTRIM(SUBSTR(m.memline,LEN(m.c_trntxt)+1,m.at_pos-; LEN(m.c_trntxt)-1)) IF LEN(m.old_text)=0 LOOP ENDIF m.old_text=STRTRAN(STRTRAN(STRTRAN(STRTRAN(m.old_text,'\\',; '\'),'\t',CHR(9)),'\n',CHR(10)),'\r',CHR(13)) m.at_pos2=AT('||',m.memline,2) m.new_text=ALLTRIM(SUBSTR(m.memline,m.at_pos+2,; IIF(m.at_pos2=0,LEN(m.memline),m.at_pos2-m.at_pos-2))) m.new_text=STRTRAN(STRTRAN(STRTRAN(STRTRAN(m.new_text,'\\',; '\'),'\t',CHR(9)),'\n',CHR(10)),'\r',CHR(13)) m.match_pos=.F. m.match_no=.F. IF m.at_pos2>0 m.at_pos=AT('||',m.memline,3) m.match_pos=VAL(SUBSTR(m.memline,m.at_pos2+2,; IIF(m.at_pos=0,LEN(m.memline),m.at_pos-m.at_pos2-2))) IF m.at_pos>0 m.match_no=VAL(SUBSTR(m.memline,m.at_pos+2)) ENDIF ENDIF REPLACE COMMENT WITH STRTRAN(COMMENT,m.memline+m.cr_lf,'') IF m.memline$COMMENT REPLACE COMMENT WITH STRTRAN(COMMENT,m.memline,'') ENDIF FOR m.j = 1 TO FCOUNT() m.field_name=FIELD(m.j) IF TYPE(m.field_name)#'M' LOOP ENDIF m.field_eval=EVALUATE(m.field_name) IF ATC(m.old_text,m.field_eval)>0 REPLACE (m.field_name) WITH strtranc(m.field_eval,m.old_text,; m.new_text,m.match_pos,m.match_no) ENDIF ENDFOR ENDIF ENDFOR ENDSCAN ENDIF IF m.gen_mode.AND.m.name_mode SCAN ALL FOR .NOT.DELETED() FOR m.j = 1 TO FCOUNT() m.field_name=FIELD(m.j) m.field_type=TYPE(m.field_name) IF m.field_type#'M' LOOP ENDIF m.field_eval=EVALUATE(m.field_name) m.at_line=ATCLINE(m.p_name,m.field_eval) IF m.at_line=0 LOOP ENDIF FOR m.i = m.at_line TO MEMLINES(m.field_eval) m.memline=ALLTRIM(MLINE(m.field_eval,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,m.field_eval,m.i)+1 IF m.at_pos=1.OR.ATC(m.p_name,SUBSTR(m.field_eval,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.p_name,m.memline) IF m.at_pos=1 m.snptname=ALLTRIM(UPPER(LEFT(CHRTRAN(STRTRAN(SUBSTR(m.memline,; m.at_pos+LEN(m.p_name)),CHR(9),' '),m.badchars,; m.stdascii),9))) IF EMPTY(m.snptname) EXIT ENDIF m.snptname_=m.snptname+IIF(TYPE('PLATFORM')#'C','D',; LEFT(PLATFORM,1)) REPLACE (m.field_name) WITH STRTRAN(m.field_eval,m.memline,; m.p_name+' '+m.snptname_) m.fnctname='FUNCTION '+m.snptname+m.cr_lf m.r=RECNO() LOCATE IF m.fnctname$PROCCODE GOTO m.r EXIT ENDIF m.paramlist='' m.at_line=ATCLINE(m.s_para,m.field_eval) IF m.at_line>0 FOR m.k = m.at_line TO MEMLINES(m.field_eval) m.memline=ALLTRIM(STRTRAN(MLINE(m.field_eval,m.k),; CHR(9),' ')) IF m.k>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,m.field_eval,m.k)+1 IF m.at_pos=1.OR.ATC(m.c_s_para,; SUBSTR(m.field_eval,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.s_para,m.memline) IF m.at_pos=1 m.at_pos=AT(' ',m.memline) IF m.at_pos>0 m.paramlist=ALLTRIM(SUBSTR(m.memline,m.at_pos)) DO WHILE .T. IF .NOT.RIGHT(m.paramlist,1)==';' EXIT ENDIF m.paramlist=LEFT(m.paramlist,LEN(m.paramlist)-1) m.k=m.k+1 IF m.k>MEMLINES(m.field_eval) EXIT ENDIF m.paramlist=m.paramlist+ALLTRIM(STRTRAN(MLINE(; m.field_eval,m.k),CHR(9),' ')) ENDDO ENDIF EXIT ENDIF ENDFOR ENDIF m.new_text=m.cr_lf+m.cr_lf+m.fnctname+; IIF(EMPTY(m.paramlist),'','PARAMETERS '+; m.paramlist+m.cr_lf)+m.cr_lf+'DO CASE'+m.cr_lf FOR m.k = 1 TO 4 DO CASE CASE m.k=1 m.new_text=m.new_text+' CASE _DOS'+m.cr_lf+; ' RETURN '+m.snptname+; 'D('+m.paramlist+')'+m.cr_lf CASE m.k=2 m.new_text=m.new_text+' CASE _WINDOWS'+m.cr_lf+; ' RETURN '+m.snptname+; 'W('+m.paramlist+')'+m.cr_lf CASE m.k=3 m.new_text=m.new_text+' CASE _MAC'+m.cr_lf+; ' RETURN '+m.snptname+; 'M('+m.paramlist+')'+m.cr_lf CASE m.k=4 m.new_text=m.new_text+' CASE _UNIX'+m.cr_lf+; ' RETURN '+m.snptname+; 'U('+m.paramlist+')'+m.cr_lf ENDCASE ENDFOR FOR m.k = 1 TO 4 m.fnctnames=m.fnctnames+1 DIMENSION a_fnctname(m.fnctnames,2) a_fnctname(m.fnctnames,1)=m.snptname+SUBSTR('DWMU',m.k,1) a_fnctname(m.fnctnames,2)=m.paramlist ENDFOR m.new_text=m.new_text+'ENDCASE'+m.cr_lf+'RETURN .F.'+m.cr_lf REPLACE PROCCODE WITH PROCCODE+m.new_text GOTO m.r EXIT ENDIF ENDFOR ENDFOR ENDSCAN ENDIF m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(7)>0 m.drv_no=7 FOR m.i = 1 TO a_scxdrvs(7) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,7),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(7)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,7)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,96,.F. ENDIF IF m.gen_mode.OR.m.lib_mode IF .NOT.m.lib_mode LOCATE m.at_pos=ATC(m.c_section3,SETUPCODE) IF m.at_pos>0.AND..NOT.wordsearch(m.c_section3,.T.)==m.null m.memline=strtranc(SUBSTR(SETUPCODE,m.at_pos),m.c_section3,; m.m_section3) REPLACE SETUPCODE WITH LEFT(SETUPCODE,m.at_pos-1) GOTO BOTTOM IF insrec() =instxt1(m.memline) ENDIF m.memline='' LOCATE ENDIF DO delaybar WITH '',m.msg2,96,.F. ENDIF RECALL ALL WHILE RECNO()<m.r_scxdata IF m.r_scxdata>RECCOUNT() m.i=0 ELSE GOTO m.r_scxdata COUNT REST FOR DELETED() TO m.i ENDIF IF m.i>0 GOTO m.r_scxdata SCAN REST FOR OBJTYPE#1.AND.DELETED() m.r=RECNO() SCAN REST FOR .NOT.DELETED().AND.VPOS<0.OR.HEIGHT<0 IF VPOS<0 REPLACE HPOS WITH HPOS-1 ENDIF IF HEIGHT<0 REPLACE WIDTH WITH WIDTH-1 ENDIF ENDSCAN GOTO m.r ENDSCAN PACK ENDIF IF m.r_scxdata>RECCOUNT() EXIT ENDIF GOTO m.r_scxdata REPLACE REST COMMENT WITH SETUPCODE, SETUPCODE WITH ''; FOR OBJTYPE#1.AND..NOT.DELETED().AND..NOT.EMPTY(SETUPCODE) IF m.gen_mode SCAN ALL FOR .NOT.DELETED() IF OBJTYPE>=32 LOOP ENDIF m.i=ATCLINE(m.c_instxt,COMMENT) IF m.i=0 LOOP ENDIF IF ATC(m.c_instxt,MLINE(COMMENT,m.i))#1 LOOP ENDIF IF OBJTYPE<32 REPLACE STYLE WITH 0 ENDIF REPLACE OBJTYPE WITH 15, OBJCODE WITH 0, EXPR WITH '',; VPOS WITH -m.scxcount, HPOS WITH RECNO()+256,; HEIGHT WITH 1, WIDTH WITH 1, PICTURE WITH '',; BOXCHAR WITH '', FILLCHAR WITH '', SCHEME WITH 0,; SCHEME2 WITH -1, COLORPAIR WITH '' IF TYPE('PLATFORM')=='C' REPLACE PENRED WITH -1, PENGREEN WITH -1, PENBLUE WITH -1,; FILLRED WITH -1, FILLGREEN WITH -1, FILLBLUE WITH -1,; PENSIZE WITH -1, PENPAT WITH -1, FONTFACE WITH '',; FONTSTYLE WITH 0, FONTSIZE WITH 0 ENDIF a_scxupd(m.scxcount)='*' REPLACE COMMENT WITH strtranc(COMMENT,m.c_instxt,m.m_instxt) ENDSCAN ENDIF IF .NOT.m.lib_mode DO delaybar WITH '',m.msg2,97,.F. ENDIF SELECT FOXSCX SET ORDER TO OBJSCX_ m.i=0 SEEK m.scx_name+m.lib_name SCAN REST FOR .NOT.OBJFLAG_; WHILE OBJSCX_==m.scx_name.AND.OBJLIB_==m.lib_name m.i=1 DELETE ENDSCAN IF m.i>0 DO delaybar WITH '',PADR('Packing: '+m.ffoxscx,50),99,.F. PACK ENDIF LOCATE ENDIF SELECT SCXDATA IF m.gen_mode GOTO m.r_scxdata SCAN REST FOR .NOT.DELETED() m.str_data=wordsearch(m.c_function) IF m.str_data=m.null.OR.EMPTY(m.str_data) LOOP ENDIF m.at_pos=ATC(m.c_function,COMMENT) m.new_str=SUBSTR(COMMENT,m.at_pos+2) m.at_pos=ATC(m.c_endfnct,m.new_str) IF m.at_pos>0 m.new_str=LEFT(m.new_str,m.at_pos+LEN(m.c_endfnct)-1)+m.cr_lf ENDIF m.new_str=m.cr_lf+m.new_str+m.cr_lf m.r=RECNO() LOCATE IF ATC('FUNCTION '+m.str_data+m.cr_lf,m.cr_lf+PROCCODE+m.cr_lf)=0 REPLACE PROCCODE WITH PROCCODE+m.new_str ELSE =warning(m.c_function+" '"+m.str_data+"' duplicated") ENDIF GOTO m.r ENDSCAN IF m.r_scxdata>RECCOUNT() EXIT ENDIF ENDIF m.match_drv=.F. IF m.gen_mode.AND.a_scxdrvs(8)>0 m.drv_no=8 FOR m.i = 1 TO a_scxdrvs(8) m.msg3=PADR('['+ALLTRIM(m.platform_)+'] '+a_scxdrv(m.i,8),50) DO delaybar WITH '',m.msg3,90*m.i/a_scxdrvs(8)+5,.F. SCAN ALL FOR .NOT.DELETED() m.match_drv=.T. DO (a_scxdrv(m.i,8)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match_drv DO delaybar WITH '',m.msg2,95,.F. ENDIF IF .NOT.m.gen_mode.AND..NOT.m.lib_mode EXIT ENDIF IF m.gen_mode m.i=0 SCAN ALL FOR .NOT.DELETED() IF .NOT.EMPTY(wordsearch(m.c_delobj)) LOOP ENDIF m.i=m.i+1 =delrec() ENDSCAN IF m.i>0 GOTO m.r_scxdata SCAN REST FOR OBJTYPE#1.AND.DELETED() m.r=RECNO() SCAN REST FOR .NOT.DELETED().AND.VPOS<0.OR.HEIGHT<0 IF VPOS<0 REPLACE HPOS WITH HPOS-1 ENDIF IF HEIGHT<0 REPLACE WIDTH WITH WIDTH-1 ENDIF ENDSCAN GOTO m.r ENDSCAN PACK ENDIF IF m.r_scxdata>RECCOUNT() EXIT ENDIF LOCATE IF '*:'$SETUPCODE REPLACE SETUPCODE WITH STRTRAN(m.cr_lf+SETUPCODE,m.lf+'*:',m.lf+'*-:') ENDIF IF '*:'$SETUPCODE REPLACE SETUPCODE WITH STRTRAN(SETUPCODE,m.cr+'*:',m.cr+'*-:') ENDIF ENDIF ENDDO IF _WINDOWS SET MESSAGE TO '' ENDIF RELEASE a_scatter IF USED('SCXBASE') USE IN SCXBASE ENDIF IF .NOT.USED('SCXDATA') EXIT ENDIF SELECT SCXDATA SET FILTER TO LOCATE IF .NOT.USED('PJXDATA') EXIT ENDIF IF m.comp_flag DO delaybar WITH '',m.msg2,100,.F. ENDIF SELECT PJXDATA m.fscxbase=STRTRAN(m.fscxbase,m.null,'') IF m.fromproj LOCATE FOR TYPE=='s'.AND.trimpath(STRTRAN(MLINE(NAME,1),; m.null,''))==trimpath(m.fscxbase) ELSE LOCATE FOR TYPE=='s'.AND.trimpath(FULLPATH(STRTRAN(STRTRAN(MLINE(NAME,1),; '..\',''),m.null,'')))==trimpath(m.fscxbase) ENDIF IF EOF() EXIT ENDIF IF .NOT.EMPTY(m.fscxdata) REPLACE NAME WITH FULLPATH(m.fscxdata,NAME) ENDIF REPLACE TIMESTAMP WITH -1 LOCATE FOR TYPE=='s'.AND.TIMESTAMP>=0.AND.; ASCAN(a_scxalias,trimpath(STRTRAN(MLINE(NAME,1),CHR(0),'')))=0 IF EOF() EXIT ENDIF m.screenset=.T. m.fscxdata='' IF _FOX25 m.platform_='' ENDIF ENDDO m.platform_=PADR(m.cplatform_,8) IF USED('PJXBASE') USE IN PJXBASE ENDIF IF USED('PJXDATA') USE IN PJXDATA ENDIF SELECT (m.lastslct) IF m.comp_flag DO delaybar WITH '','',0,.T. ENDIF DO esc_check RETURN .T. * END genscx FUNCTION updspr PARAMETER m.projdbf,m.recno PRIVATE m.projdbf,m.recno,m.memline,m.memline2,m.at_pos,m.at_pos2,m.at_pos3 PRIVATE m.lastslct,m.decimals,m.find_str,m.i,m.j,m.k,m.n,m.scx_no,m.ascstr PRIVATE m.finsert,m.insfiles,m.inscount,m.inspos,m.fnameold,m.fnamenew PRIVATE m.scx_alias,m.new_text,m.match,m.rplatform_,m.inserttop IF .NOT.TYPE('a_scxalias')=='C' RETURN .F. ENDIF m.lastslct=SELECT() FOR m.i = 1 TO 16 IF USED(a_scxalias(m.i)) USE IN (a_scxalias(m.i)) ENDIF ENDFOR IF USED('SCXDATA') USE IN SCXDATA ENDIF IF USED('SPRDATA') SELECT SPRDATA USE ENDIF IF m.scxcount=0 SELECT (m.lastslct) RETURN .F. ENDIF CREATE CURSOR SPRDATA (SPR M, INS M) INSERT BLANK APPEND MEMO SPR FROM (m.fsprout) OVERWRITE FOR m.scx_no = 1 TO m.scxcount IF TYPE('a_fscxdata(m.scx_no)')=='C' m.fscxdata=a_fscxdata(m.scx_no) ENDIF m.fnameold=ALLTRIM(UPPER(trimpath(m.fscxdata,.T.))) m.fnamenew=PADL(UPPER(trimpath(m.fsprout,.T.)),LEN(m.fnameold)) IF m.fnameold$SPR REPLACE SPR WITH STRTRAN(SPR,m.fnameold,m.fnamenew) ENDIF ENDFOR IF '{{'$SPR REPLACE SPR WITH evltxt(SPR) ENDIF m.j=0 FOR m.i = 1 TO 6 IF a_sprdrvs(m.i)>0 m.j=m.i EXIT ENDIF ENDFOR IF m.j=0.AND.m.fnctnames=0.AND.AT(m.lf+'@ -',SPR)=0.AND.; ATC(m.c_insert,SPR)=0.AND.ATC(m.p_insert,SPR)=0.AND.ASCAN(a_scxupd,'*')=0 COPY MEMO SPR TO (m.fsprout) SELECT (m.lastslct) RETURN .F. ENDIF IF _WINDOWS m.fsprout=LOWER(m.fsprout) SET MESSAGE TO PADR('Updating Screen Code: '+m.fsprout,79) ELSE m.fsprout=UPPER(m.fsprout) ENDIF m.msg1=PADR('Updating Screen Code...',50) m.msg2=PADR(m.fsprout,50) DO delaybar WITH m.msg1,m.msg2,0,.T. DO esc_check SELECT SPRDATA IF a_sprdrvs(1)>0 m.drv_no=-1 FOR m.i = 1 TO a_sprdrvs(1) DO (a_sprdrv(m.i,1)) DO esc_check LOCATE ENDFOR DO restoreenv ENDIF SELECT SPRDATA IF m.fnctnames>0 FOR m.i = 1 TO m.fnctnames m.find_str=m.lf+'FUNCTION '+ALLTRIM(a_fnctname(m.i,1))+' ' IF ATC(m.find_str,SPR)>0 LOOP ENDIF m.memline=ALLTRIM(a_fnctname(m.i,2)) REPLACE SPR WITH SPR+m.cr_lf+m.cr_lf+m.find_str+m.cr_lf+; IIF(EMPTY(m.memline),'','PARAMETERS '+m.memline+; m.cr_lf)+'RETURN .F.'+m.cr_lf ENDFOR ENDIF FOR m.scx_no = 1 TO m.scxcount IF USED('SCXDATA') SELECT SCXDATA USE ELSE SELECT 0 ENDIF m.fscxdata=a_fscxdata(m.scx_no) USE (m.fscxdata) ALIAS SCXDATA SET FILTER TO .NOT.DELETED().AND.OBJTYPE#2.AND.OBJTYPE#10 LOCATE IF a_sprdrvs(2)>0 m.drv_no=-2 FOR m.i = 1 TO a_sprdrvs(2) m.msg3=PADR(a_sprdrv(m.i,2),50) DO delaybar WITH '',m.msg3,90*m.i/a_sprdrvs(2)+5,.F. SCAN ALL DO (a_sprdrv(m.i,2)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF DO delaybar WITH '',m.msg2,5,.F. SCAN ALL IF ATC(m.m_size,COMMENT)=0.AND.ATC(m.m_nosize,COMMENT)=0 LOOP ENDIF DO delaybar WITH '','',20*RECNO()/RECCOUNT(),.F. DO esc_check IF TYPE('PLATFORM')=='C' m.rplatform=ALLTRIM(PLATFORM) ELSE m.rplatform='DOS' ENDIF DO CASE CASE m.rplatform=='DOS' m.decimals=0 CASE m.rplatform=='WINDOWS' m.decimals=3 CASE m.rplatform=='MAC' m.decimals=3 CASE m.rplatform=='UNIX' m.decimals=0 OTHERWISE m.decimals=0 ENDCASE FOR m.n = 1 TO IIF(OBJTYPE=15.AND.OBJCODE=0.AND.REFRESH,2,1) FOR m.j = 1 TO 3 DO CASE CASE m.j=1 m.ascstr=' ' CASE m.j=2 m.ascstr=',' OTHERWISE m.ascstr='' ENDCASE m.find_str='SIZE '+ALLTRIM(STR(m.scx_no+IIF(OBJTYPE#15.OR.; OBJCODE#2,-100,800),4))+IIF(m.decimals=0,'','.'+; REPLICATE('0',m.decimals))+','+; ALLTRIM(STR(RECNO()+256,10,m.decimals))+m.ascstr m.i=ATCLINE(m.find_str,SPRDATA.SPR) IF m.i=0 LOOP ENDIF m.at_pos=ATC(m.find_str,SPRDATA.SPR) m.memline=MLINE(SPRDATA.SPR,m.i) m.k=0 IF EMPTY(SHOW) IF RIGHT(m.memline,1)==';' m.memline=m.memline+m.cr_lf ELSE m.memline=';'+m.cr_lf+m.memline+m.cr_lf m.at_pos=m.at_pos-OCCURS(CHR(9),m.memline)-3 m.k=1 ENDIF ELSE m.memline=STRTRAN(m.memline,CHR(9),'') IF RIGHT(m.memline,1)==';' m.memline=LEFT(m.memline,LEN(m.memline)-1) ENDIF ENDIF m.new_text=IIF(EMPTY(SHOW),'',ALLTRIM(MLINE(SHOW,1))+' ')+; IIF(m.k=0,'',m.cr_lf) REPLACE SPRDATA.SPR WITH LEFT(SPRDATA.SPR,m.at_pos-1)+m.new_text+; SUBSTR(SPRDATA.SPR,m.at_pos+LEN(m.memline)) EXIT ENDFOR ENDFOR ENDSCAN m.match=.F. IF a_sprdrvs(3)>0 m.drv_no=-3 FOR m.i = 1 TO a_sprdrvs(3) m.msg3=PADR(a_sprdrv(m.i,3),50) DO delaybar WITH '',m.msg3,90*m.i/a_sprdrvs(3)+5,.F. SCAN ALL m.match=.T. DO (a_sprdrv(m.i,3)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match DO delaybar WITH '',m.msg2,20,.F. ENDIF SCAN ALL IF ATC(m.m_instxt,COMMENT)=0 LOOP ENDIF DO delaybar WITH '','',70*RECNO()/RECCOUNT()+20,.F. DO esc_check IF TYPE('PLATFORM')=='C' m.rplatform=ALLTRIM(PLATFORM) ELSE m.rplatform='DOS' ENDIF DO CASE CASE m.rplatform=='DOS' m.decimals=0 CASE m.rplatform=='WINDOWS' m.decimals=3 CASE m.rplatform=='MAC' m.decimals=3 CASE m.rplatform=='UNIX' m.decimals=0 OTHERWISE m.decimals=0 ENDCASE FOR m.n = 1 TO IIF(OBJTYPE#15.OR.OBJCODE#0.OR..NOT.REFRESH,1,2) m.find_str='@ '+ALLTRIM(STR(-m.scx_no,4))+IIF(m.decimals=0,'','.'+; REPLICATE('0',m.decimals)) m.find_str=m.find_str+','+ALLTRIM(STR(RECNO()+256,10,m.decimals))+' ' m.i=ATCLINE(m.find_str,SPRDATA.SPR) IF m.i=0 LOOP ENDIF m.at_pos=ATC(m.find_str,SPRDATA.SPR) m.memline=MLINE(SPRDATA.SPR,m.i)+m.cr_lf FOR m.j = 1 TO 5 m.memline2=ALLTRIM(MLINE(SPRDATA.SPR,m.i+m.j)) IF INLIST(UPPER(LEFT(STRTRAN(m.memline2,CHR(9),''),4)),'SIZE','PEN ',; 'STYL','FONT','COLO') m.memline=m.memline+m.memline2+m.cr_lf ELSE EXIT ENDIF ENDFOR m.find_str=m.m_instxt m.at_pos2=ATC(m.find_str,COMMENT) IF m.at_pos2=0 m.new_text='' ELSE m.memline2=ALLTRIM(SUBSTR(COMMENT,m.at_pos2+LEN(m.find_str)+1)) m.at_pos3=ATC(m.c_endtxt,m.memline2) IF m.at_pos3>0 m.memline2=LEFT(m.memline2,m.at_pos3+LEN(m.c_endtxt)-1)+m.cr_lf ENDIF IF m.outtxt=='ON' m.new_text=m.cr_lf+'** Start of inserted text'+m.cr_lf+; m.memline2+m.cr_lf+m.cr_lf+'** End of inserted text'+m.cr_lf ELSE m.new_text=m.memline2+m.cr_lf ENDIF ENDIF REPLACE SPRDATA.SPR WITH LEFT(SPRDATA.SPR,m.at_pos-1)+m.new_text+; SUBSTR(SPRDATA.SPR,m.at_pos+LEN(m.memline)-1) ENDFOR ENDSCAN IF a_sprdrvs(4)>0 m.drv_no=-4 FOR m.i = 1 TO a_sprdrvs(4) m.msg3=PADR(a_sprdrv(m.i,4),50) DO delaybar WITH '',m.msg3,90*m.i/a_sprdrvs(4)+5,.F. SCAN ALL DO (a_sprdrv(m.i,4)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF DO delaybar WITH '','',90,.F. IF USED('SCXDATA') SELECT SCXDATA USE ENDIF ENDFOR SELECT SPRDATA m.find_str='@ -' DO WHILE .T. DO esc_check m.i=ATCLINE(m.find_str,SPR) IF m.i=0 EXIT ENDIF m.at_pos=ATC(m.find_str,SPR) m.memline=MLINE(SPR,m.i)+m.cr_lf FOR m.j = 1 TO 5 m.memline2=ALLTRIM(MLINE(SPR,m.i+m.j)) IF INLIST(UPPER(LEFT(STRTRAN(m.memline2,CHR(9),''),4)),'SIZE','PEN ',; 'STYL','FONT','COLO') m.memline=m.memline+m.memline2+m.cr_lf ELSE EXIT ENDIF ENDFOR REPLACE SPR WITH LEFT(SPR,m.at_pos-1)+SUBSTR(SPR,m.at_pos+LEN(m.memline)-1) ENDDO m.match=.F. IF a_sprdrvs(5)>0 m.drv_no=-5 FOR m.i = 1 TO a_sprdrvs(5) m.msg3=PADR(a_sprdrv(m.i,5),50) DO delaybar WITH '',m.msg3,90*m.i/a_sprdrvs(5)+5,.F. SCAN ALL m.match=.T. DO (a_sprdrv(m.i,5)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match DO delaybar WITH '',m.msg2,90,.F. ENDIF DIMENSION a_insfile(1) m.insfiles=0 m.at_pos2=1 FOR m.k = 1 TO 2 m.find_str=IIF(m.k=1,m.c_insert,m.p_insert) DO WHILE .T. DO esc_check m.at_pos=ATC(m.find_str,SUBSTR(SPR,m.at_pos2)) IF m.at_pos=0 EXIT ENDIF m.at_pos=m.at_pos+m.at_pos2-1 m.inserttop=(m.k=1.AND.UPPER(SUBSTR(SPR,m.at_pos,11))==m.c_insert+'TOP') m.at_pos=m.at_pos-2 m.ascstr=ASC(SUBSTR(SPR,m.at_pos-1,1)) IF m.ascstr=10.OR.m.ascstr=13 m.at_pos=m.at_pos-1 ENDIF m.j=LEN(m.find_str) FOR m.i = 1 TO 2 IF EMPTY(SUBSTR(SPR,m.at_pos+m.i,1)) EXIT ENDIF m.j=m.j+1 ENDFOR m.at_pos3=0 FOR m.i = -m.j TO m.j m.memline=MLINE(SPR,1,m.at_pos) m.at_pos3=ATC(m.find_str,m.memline) IF m.at_pos3>0 EXIT ENDIF m.at_pos=m.at_pos+1 ENDFOR m.memline2=IIF(m.at_pos3>0,ALLTRIM(STRTRAN(m.memline,CHR(9),' ')),'') IF ATC(m.find_str,m.memline2)#1 m.at_pos2=m.at_pos+LEN(m.memline)+2 LOOP ENDIF IF m.ascstr=10.OR.m.ascstr=13 m.memline=m.memline+' ' ENDIF m.at_pos=m.at_pos+1 m.j=0 FOR m.i = 1 TO 256 m.ascstr=ASC(SUBSTR(SPR,m.at_pos-m.i,1)) IF m.ascstr=10.OR.m.ascstr=13.OR.(m.at_pos-m.i)<=0 EXIT ENDIF m.j=-1 ENDFOR IF m.j=-1.OR.m.i>256 m.at_pos2=m.at_pos+LEN(m.memline)+2 LOOP ENDIF m.finsert=ALLTRIM(SUBSTR(m.memline2,AT(' ',m.memline2))) DO WHILE RIGHT(m.finsert,1)==m.cr.OR.RIGHT(m.finsert,1)==m.lf DO esc_check m.finsert=LEFT(m.finsert,LEN(m.finsert)-1) ENDDO IF FILE(m.finsert) m.inscount=0 m.inspos=ASCAN(a_insfile,m.finsert) DO WHILE m.inspos>0.AND.m.inscount<256 m.inscount=m.inscount+1 m.inspos=ASCAN(a_insfile,m.finsert,m.inspos+1) ENDDO IF m.inscount>256 REPLACE SPR WITH LEFT(SPR,m.at_pos-1)+'*'+SUBSTR(SPR,m.at_pos) m.at_pos2=m.at_pos+LEN(m.memline)+2 LOOP ENDIF m.insfiles=m.insfiles+1 DIMENSION a_insfile(m.insfiles) a_insfile(m.insfiles)=m.finsert APPEND MEMO INS FROM (m.finsert) OVERWRITE m.new_text=INS m.new_text='** Start of inserted file '+m.finsert+; ' ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒstart'+m.cr_lf+; m.new_text+m.cr_lf+'** End of inserted file '+; m.finsert+' ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒend'+; m.cr_lf ELSE =warning(m.c_insert,m.finsert) m.new_text='*'+m.cr_lf+'* Inserted file '+m.finsert+' not found!'+; cr_lf+'*'+m.cr_lf ENDIF m.i=LEN(m.memline) IF m.inserttop m.memline=ALLTRIM(m.memline)+m.cr_lf REPLACE SPR WITH LEFT(SPR,m.at_pos-1)+m.cr_lf+; strtranc(SUBSTR(SPR,m.at_pos+m.i+1),m.memline,m.cr_lf) m.at_pos3=ATC(m.cr_lf+m.cr_lf,SPR) IF m.at_pos3=0.OR.m.at_pos3>=m.at_pos.OR.; (m.at_pos3>=ATC(m.cr_lf+'DO CASE',SPR).AND.; m.at_pos3>=ATC(m.cr_lf+'#REGION 1',SPR)) m.at_pos3=1 ELSE m.at_pos3=m.at_pos3+2 ENDIF REPLACE SPR WITH LEFT(SPR,m.at_pos3-1)+m.cr_lf+m.new_text+; SUBSTR(SPR,m.at_pos3) m.at_pos2=1 ELSE REPLACE SPR WITH LEFT(SPR,m.at_pos-1)+m.new_text+; SUBSTR(SPR,m.at_pos+m.i+1) ENDIF ENDDO ENDFOR DO delaybar WITH '','',95,.F. IF '{{'$SPR REPLACE SPR WITH evltxt(SPR) ENDIF m.match=.F. IF a_sprdrvs(6)>0 m.drv_no=-6 FOR m.i = 1 TO a_sprdrvs(6) m.msg3=PADR(a_sprdrv(m.i,6),50) DO delaybar WITH '',m.msg3,90*m.i/a_sprdrvs(6)+5,.F. SCAN ALL m.match=.T. DO (a_sprdrv(m.i,6)) DO esc_check ENDSCAN LOCATE SCATTER MEMVAR MEMO ENDFOR DO restoreenv ENDIF IF m.match DO delaybar WITH '',m.msg2,95,.F. ENDIF COPY MEMO SPR TO (m.fsprout) DO delaybar WITH '','',100,.F. IF _WINDOWS SET MESSAGE TO '' ENDIF SELECT (m.lastslct) DO delaybar WITH '','',0,.T. DO esc_check RETURN .T. * END updspr FUNCTION openfoxscx PRIVATE m.i,m.configfile IF USED('FOXSCX') SELECT FOXSCX LOCATE RETURN .T. ENDIF IF FILE(m.ffoxscx) SELECT 0 USE (m.ffoxscx) ALIAS FOXSCX IF (.NOT._FOX25.OR..NOT.USED('SCXBASE').OR.; FCOUNT('SCXBASE')=(FCOUNT()-m.fcountadj)).AND.; LEN(OBJFIELD_)=24 USE ELSE m.ffoxscx2=FULLPATH(uniquefile(),m.ffoxscx) SELECT * FROM FOXSCX INTO TABLE (m.ffoxscx2) USE SELECT FOXSCX USE =erasedbf(m.ffoxscx,'FOXSCX') ENDIF ENDIF IF FILE(m.ffoxscx).OR..NOT.USED('SCXBASE') IF USED('FOXSCX') SELECT FOXSCX ELSE IF .NOT.FILE(m.ffoxscx) RETURN .F. ENDIF SELECT 0 USE (m.ffoxscx) ALIAS FOXSCX ENDIF ELSE SELECT SCXBASE m.i=AFIELDS(a_fscatter) IF .NOT._FOX25 m.i=AFIELDS(a_fscatter) DIMENSION a_fscatter(m.i+1,4) a_fscatter(m.i+1,1)='PLATFORM' a_fscatter(m.i+1,2)='C' a_fscatter(m.i+1,3)=8 a_fscatter(m.i+1,4)=0 m.i=m.i+1 ENDIF DIMENSION a_fscatter(m.i+8,4) a_fscatter(m.i+1,1)='OBJNAME_' a_fscatter(m.i+1,2)='C' a_fscatter(m.i+1,3)=24 a_fscatter(m.i+1,4)=0 a_fscatter(m.i+2,1)='OBJBASE_' a_fscatter(m.i+2,2)='C' a_fscatter(m.i+2,3)=35 a_fscatter(m.i+2,4)=0 a_fscatter(m.i+3,1)='OBJFIELD_' a_fscatter(m.i+3,2)='C' a_fscatter(m.i+3,3)=24 a_fscatter(m.i+3,4)=0 a_fscatter(m.i+4,1)='OBJLIB_' a_fscatter(m.i+4,2)='C' a_fscatter(m.i+4,3)=10 a_fscatter(m.i+4,4)=0 a_fscatter(m.i+5,1)='OBJSCX_' a_fscatter(m.i+5,2)='C' a_fscatter(m.i+5,3)=8 a_fscatter(m.i+5,4)=0 a_fscatter(m.i+6,1)='OBJFLAG_' a_fscatter(m.i+6,2)='L' a_fscatter(m.i+6,3)=1 a_fscatter(m.i+6,4)=0 a_fscatter(m.i+7,1)='OBJCMNT_' a_fscatter(m.i+7,2)='M' a_fscatter(m.i+7,3)=10 a_fscatter(m.i+7,4)=0 a_fscatter(m.i+8,1)='OBJMEMO_' a_fscatter(m.i+8,2)='M' a_fscatter(m.i+8,3)=10 a_fscatter(m.i+8,4)=0 CREATE DBF (m.ffoxscx) FROM ARRAY a_fscatter USE RELEASE a_fscatter SELECT 0 USE (m.ffoxscx) ALIAS FOXSCX IF FILE(m.ffoxscx2+'.DBF') APPEND FROM (m.ffoxscx2) =erasedbf(m.ffoxscx2,m.ffoxscx2) ENDIF ENDIF SELECT FOXSCX m.i=0 IF .NOT.TAG(1)=='OBJNAME_'.OR..NOT.KEY(1)=='UPPER(OBJNAME_)+OBJLIB_' m.i=1 ENDIF IF .NOT.TAG(2)=='OBJBASE_'.OR..NOT.KEY(2)=='OBJBASE_+OBJLIB_' m.i=2 ENDIF IF .NOT.TAG(3)=='OBJFIELD_'.OR..NOT.KEY(3)=='OBJFIELD_+OBJLIB_' m.i=3 ENDIF IF .NOT.TAG(4)=='OBJLIB_'.OR..NOT.KEY(4)=='OBJLIB_+UPPER(OBJNAME_)' m.i=4 ENDIF IF .NOT.TAG(5)=='OBJSCX_'.OR..NOT.KEY(5)=='OBJSCX_+OBJLIB_+UPPER(OBJNAME_)' m.i=5 ENDIF IF m.i>0 DELETE TAG ALL INDEX ON UPPER(OBJNAME_)+OBJLIB_ TAG OBJNAME_ INDEX ON OBJBASE_+OBJLIB_ TAG OBJBASE_ INDEX ON OBJFIELD_+OBJLIB_ TAG OBJFIELD_ INDEX ON OBJLIB_+UPPER(OBJNAME_) TAG OBJLIB_ INDEX ON OBJSCX_+OBJLIB_+UPPER(OBJNAME_) TAG OBJSCX_ ENDIF IF EMPTY(FILTER()).AND.TYPE('PLATFORM')=='C' IF TYPE('m.platform_')#'C'.OR.EMPTY(m.platform_) SET FILTER TO PLATFORM==m.cplatform_ ELSE SET FILTER TO PLATFORM==m.platform_ ENDIF ENDIF LOCATE RETURN .T. * END openfoxscx FUNCTION strtranc PARAMETERS m.expc1,m.expc2,m.expc3,m.expn1,m.expn2 PRIVATE m.expc1,m.expc2,m.expc3,m.expn1,m.expn2 PRIVATE m.expr,m.at_pos,m.at_pos2,m.i,m.j IF TYPE('m.expc1')#'C' RETURN '' ENDIF IF TYPE('m.expc2')#'C'.OR.TYPE('m.expc2')#'C'.OR.EMPTY(m.expc1).OR.; EMPTY(m.expc2) RETURN m.expc1 ENDIF m.expr=m.expc1 IF TYPE('m.expn1')#'N' m.expn1=1 ENDIF IF TYPE('m.expn2')#'N' m.expn2=LEN(m.expc1) ENDIF IF m.expn1<1.OR.m.expn2<1 RETURN m.expc1 ENDIF m.i=0 m.j=0 m.at_pos2=1 DO WHILE .T. m.at_pos=ATC(m.expc2,SUBSTR(m.expr,m.at_pos2)) IF m.at_pos=0 EXIT ENDIF m.i=m.i+1 IF m.i<m.expn1 m.at_pos2=m.at_pos+m.at_pos2+LEN(m.expc2)-1 LOOP ENDIF m.expr=LEFT(m.expr,m.at_pos+m.at_pos2-2)+m.expc3+; SUBSTR(m.expr,m.at_pos+m.at_pos2+LEN(m.expc2)-1) m.j=m.j+1 IF m.j>=m.expn2 EXIT ENDIF m.at_pos2=m.at_pos+m.at_pos2+LEN(m.expc3)-1 IF m.at_pos2>LEN(m.expr) EXIT ENDIF ENDDO RETURN m.expr * END strtranc FUNCTION linesearch PARAMETERS m.find_str,m.searchstup PRIVATE m.find_str,m.searchstup RETURN wordsearch(m.find_str,m.searchstup,.T.) * END linesearch FUNCTION wordsearch PARAMETERS m.find_str,m.searchstup,m.ignoreword PRIVATE m.find_str,m.searchstup,m.memdata,m.mem_lines,m.memline,m.at_line,m.i,m.str_data m.memdata=IIF(m.searchstup,SETUPCODE,COMMENT) m.at_line=ATCLINE(m.find_str,m.memdata) IF m.at_line=0 RETURN m.null ENDIF m.mem_lines=MEMLINES(m.memdata) FOR m.i = m.at_line TO m.mem_lines m.memline=ALLTRIM(MLINE(m.memdata,m.i)) DO WHILE LEFT(m.memline,1)==CHR(9) m.memline=ALLTRIM(SUBSTR(m.memline,2)) ENDDO IF ATC(m.find_str,m.memline)=1 m.str_data=IIF(m.ignoreword,'',SUBSTR(m.memline,LEN(m.find_str)+1,1)) IF EMPTY(m.str_data) RETURN ALLTRIM(SUBSTR(m.memline,ATC(m.find_str,m.memline)+; LEN(m.find_str))) EXIT ENDIF ENDIF ENDFOR RETURN m.null * END wordsearch FUNCTION erasedbf PARAMETERS m.dbf_name,m.dbf_alias PRIVATE m.dbf_name,m.dbf_alias,m.ferase IF USED(m.dbf_alias) USE IN (m.dbf_alias) ENDIF m.dbf_name=trimext(m.dbf_name) m.ferase=m.dbf_name+'.DBF' IF FILE(m.ferase) ERASE (m.ferase) ENDIF m.ferase=m.dbf_name+'.FPT' IF FILE(m.ferase) ERASE (m.ferase) ENDIF RETURN .T. * END erasedbf FUNCTION configfp PARAMETERS m.find_opt,m.find_dflt PRIVATE m.find_opt,m.find_dflt,m.cnfg_opt,m.config_str PRIVATE m.memline,m.at_pos,m.at_pos2,m.i IF TYPE('m.find_dflt')#'C' m.find_dflt='' ENDIF IF EMPTY(m.find_opt).OR.EMPTY(m.fconfigfp) RETURN UPPER(ALLTRIM(m.find_dflt)) ENDIF m.config_str=CONFIGFP.FP m.find_opt=UPPER(m.find_opt) m.cnfg_opt=m.find_dflt FOR m.i = 1 TO 255 m.at_pos=ATC(m.find_opt,m.config_str,m.i) IF m.at_pos=0 EXIT ENDIF IF m.at_pos>1 m.memline=SUBSTR(m.config_str,m.at_pos-1,1) IF .NOT.INLIST(m.memline,m.lf,m.cr,' ',CHR(9)) EXIT ENDIF ENDIF m.memline=STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(ALLTRIM(UPPER(; SUBSTR(m.config_str,m.at_pos))),CHR(34),''),CHR(39),''),; '[',''),']',''),' ','') DO WHILE LEFT(m.memline,1)==CHR(9) m.memline=ALLTRIM(SUBSTR(m.memline,2)) ENDDO m.at_pos2=AT(m.cr,m.memline) IF m.at_pos2>0 m.memline=LEFT(m.memline,m.at_pos2-1) ENDIF m.at_pos=AT('=',m.memline) IF m.at_pos=(LEN(m.find_opt)+1) m.cnfg_opt=SUBSTR(m.memline,m.at_pos+1) EXIT ENDIF ENDFOR RETURN UPPER(ALLTRIM(m.cnfg_opt)) * END configfp FUNCTION trimext PARAMETERS m.filename PRIVATE m.filename,m.at_pos m.at_pos=AT('.',m.filename) IF m.at_pos>0 m.filename=LEFT(m.filename,m.at_pos-1) ENDIF RETURN ALLTRIM(m.filename) * END trimext FUNCTION trimpath PARAMETERS m.filename,m.trim_ext PRIVATE m.filename,m.trim_ext,m.at_pos m.at_pos=AT(':',m.filename) IF m.at_pos>0 m.filename=SUBSTR(m.filename,m.at_pos+1) ENDIF IF m.trim_ext m.filename=trimext(m.filename) ENDIF RETURN ALLTRIM(SUBSTR(m.filename,AT('\',m.filename,; MAX(OCCURS('\',m.filename),1))+1)) * END trimpath FUNCTION uniquefile PRIVATE m.filename DO WHILE .T. m.filename='_'+ALLTRIM(SUBSTR(SYS(3),2,7)) IF .NOT.FILE(m.filename+'.DBF') EXIT ENDIF ENDDO RETURN (m.filename) * END uniquefile FUNCTION add_fext PARAMETERS m.filename PRIVATE m.filename,m.i IF EMPTY(m.filename).OR.'.'$m.filename m.filename=IIF(_WINDOWS,LOWER(m.filename),UPPER(m.filename)) RETURN m.filename ENDIF FOR m.i = 1 TO ALEN(a_file_ext) IF FILE(m.filename+a_file_ext(m.i)) m.filename=m.filename+a_file_ext(m.i) m.filename=IIF(_WINDOWS,LOWER(m.filename),UPPER(m.filename)) RETURN m.filename ENDIF ENDFOR m.filename=m.filename+'.PRG' m.filename=IIF(_WINDOWS,LOWER(m.filename),UPPER(m.filename)) RETURN m.filename * END add_fext PROCEDURE delaybar PARAMETERS m.msg1,m.msg2,m.percent,m.flag PRIVATE m.msg1,m.msg2,m.percent,m.flag,m.center_row,m.col PRIVATE m.delay_cols,m.delay_bar DO CASE CASE .NOT.m.flag IF _WINDOWS.OR._MAC DO updthrm WITH (m.msg1),(m.msg2),(m.percent) RETURN ENDIF IF .NOT.WEXIST('_wdelaybar') RETURN ENDIF ACTIVATE WINDOW _wdelaybar @ 0,3 SAY m.msg1 @ 1,3 SAY m.msg2 m.delay_cols=INT(MIN(m.percent,100)/2) IF m.percent>0 m.delay_bar=REPLICATE('€',m.delay_cols) IF MOD(ROUND(MIN(m.percent,100)-.5,0),2)=1 m.delay_bar=m.delay_bar+'›' ENDIF @ 3,3 SAY m.delay_bar IF LEN(m.delay_bar)<50 ?? SPACE(50-LEN(m.delay_bar)) ENDIF ENDIF RETURN CASE .NOT.EMPTY(m.msg1) IF _WINDOWS.OR._MAC DO actthrm WITH (m.msg1),(m.msg2) RETURN ENDIF m.center_row=INT(SROWS()/2) m.col=INT((SCOLS()-58)/2) DEFINE WINDOW _wdelaybar FROM m.center_row-3,m.col; TO m.center_row+3,m.col+57; DOUBLE COLOR SCHEME 5 ACTIVATE WINDOW _wdelaybar @ 0,3 SAY m.msg1 @ 1,3 SAY m.msg2 @ 2,1 TO 4,54 @ 3,3 SAY SPACE(50) COLOR SCHEME 5 RETURN OTHERWISE IF _WINDOWS.OR._MAC DO deactthrmo RETURN ENDIF RELEASE WINDOW _wdelaybar RETURN ENDCASE RETURN * END delaybar PROCEDURE actthrm PARAMETER m.text,m.prompt PRIVATE m.text,m.prompt,m.rgb_color PRIVATE clauses_ m.rgb_color='RGB(0, 0, 0, 192, 192, 192)' clauses_="SIZE 5.615,63.833 FONT '"+m.c_dlgface+"',"+STR(m.c_dlgsize,10,5)+; " STYLE '"+m.c_dlgstyle+"'" DEFINE WINDOW thrmomete; AT INT((SROW() - (( 5.615 *; FONTMETRIC(1, m.c_dlgface, m.c_dlgsize, m.c_dlgstyle )) /; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2),; INT((SCOL() - (( 63.833 *; FONTMETRIC(6, m.c_dlgface, m.c_dlgsize, m.c_dlgstyle )) /; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2); &clauses_; NOFLOAT; NOCLOSE; NONE; COLOR (m.rgb_color) clauses_='CENTER' MOVE WINDOW thrmomete &clauses_ ACTIVATE WINDOW thrmomete NOSHOW clauses_="FONT '"+m.c_dlgface+"',"+STR(m.c_dlgsize,10,5)+; " STYLE '"+m.c_dlgstyle+"'" @ 0.5,3 SAY m.text &clauses_ @ 1.5,3 SAY m.prompt &clauses_ m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 0.000,0.000 TO 0.000,63.833; COLOR (m.rgb_color) m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 0.000,0.000 TO 5.615,0.000; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 0.385,0.667 TO 5.231,0.667; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 0.308,0.667 TO 0.308,63.167; COLOR (m.rgb_color) m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 0.385,63.000 TO 5.308,63.000; COLOR (m.rgb_color) m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 5.231,0.667 TO 5.231,63.167; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 5.538,0.000 TO 5.538,63.833; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 0.000,63.667 TO 5.615,63.667; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 3.000,3.333 TO 4.231,3.333; COLOR (m.rgb_color) m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 3.000,60.333 TO 4.308,60.333; COLOR (m.rgb_color) m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 3.000,3.333 TO 3.000,60.333; COLOR (m.rgb_color) m.rgb_color='RGB(255, 255, 255, 255, 255, 255)' @ 4.231,3.333 TO 4.231,60.500; COLOR (m.rgb_color) SHOW WINDOW thrmomete TOP RETURN * END actthrm PROCEDURE updthrm PARAMETER m.text,m.prompt,m.percent PRIVATE m.text,m.prompt,m.nblocks,m.percent,m.rgb_color PRIVATE clauses_ ACTIVATE WINDOW thrmomete clauses_="FONT '"+m.c_dlgface+"',"+STR(m.c_dlgsize,10,5)+; " STYLE '"+m.c_dlgstyle+"'" IF .NOT.EMPTY(m.text) @ 0.5,3 SAY m.text &clauses_ ENDIF IF .NOT.EMPTY(m.prompt) @ 1.5,3 SAY m.prompt &clauses_ ENDIF m.percent=MIN(m.percent,100) m.nblocks=(m.percent/100) * 56.269 clauses_='PATTERN 1' m.rgb_color='RGB(128, 128, 128, 128, 128, 128)' @ 3.000,3.333 TO 4.231,m.nblocks + 3.333 &clauses_; COLOR (m.rgb_color) IF m.percent<100 @ 3.100,m.nblocks + 3.333 CLEAR TO 4.231,59.602 ENDIF RETURN * END updthrm PROCEDURE deactthrmo IF WEXIST("thrmomete") RELEASE WINDOW thrmomete ENDIF RETURN * END deactthrmo FUNCTION warning PARAMETERS m.cmnd_str,m.operand PRIVATE m.cmnd_str,m.operand m.warnings=m.warnings+1 IF TYPE('m.cmnd_str')#'C' RETURN m.warnings ENDIF IF TYPE('m.operand')=='C' m.operand=STRTRAN(m.operand,' ','') IF LEFT(m.operand,1)=='.' m.operand=SUBSTR(m.operand,2) ENDIF m.cmnd_str=m.cmnd_str+" '"+m.operand+"' not found" ENDIF IF TYPE('m.fscxbase')=='C'.AND..NOT.EMPTY(m.fscxbase) m.cmnd_str=m.cmnd_str+' ['+trimpath(m.fscxbase)+']' ENDIF WAIT CLEAR IF TYPE('m.autohalt')=='C'.AND.m.autohalt=='OFF' WAIT LEFT(m.cmnd_str,254) WINDOW NOWAIT RETURN m.warnings ENDIF IF .NOT.EMPTY(_FOX25REV) m.cmnd_str='GENSCRNX Warning Mode - {C}ancel {S}uspend {I}gnore'+CHR(13)+; CHR(13)+m.cmnd_str ENDIF CLEAR TYPEAHEAD WAIT LEFT(m.cmnd_str,254) WINDOW DO CASE CASE MDOWN() =.F. CASE UPPER(CHR(LASTKEY()))=='I' RETURN m.warnings CASE UPPER(CHR(LASTKEY()))=='S' m.lasterror=ON('ERROR') ON ERROR WAIT CLEAR CLEAR TYPEAHEAD m.lastcursr=SET('CURSOR') ACTIVATE WINDOW Command SET ESCAPE ON SUSPEND SET ESCAPE OFF SET CURSOR &lastcursr ON ERROR &lasterror RETURN m.warnings ENDCASE DO cleanup CANCEL * END warning PROCEDURE errorhnd PARAMETER m.error_no,m.msg,m.prg_name,m.line_no,m.codeline PRIVATE m.error_no,m.msg,m.prg_name,m.line_no,m.codeline,m.colright PRIVATE m.row,m.col,m.lasterror,m.lastcursr,m.prompt m.lasterror=ON('ERROR') ON ERROR SET ESCAPE OFF WAIT CLEAR CLEAR GETS CLEAR TYPEAHEAD m.lastcursr=SET('CURSOR') SET CURSOR OFF m.row=IIF(_DOS.OR._UNIX,INT((SROWS()-20)/2),0) m.col=IIF(_DOS.OR._UNIX,INT((SCOLS()-69)/2),0) DEFINE WINDOW win_prompt FROM m.row,m.col; TO m.row+20,m.col+69; TITLE ' GENSCRNX Error Mode '; DOUBLE FLOAT SHADOW COLOR SCHEME 7 ACTIVATE WINDOW win_prompt m.colright=WCOLS()-19 m.codeline=ALLTRIM(m.codeline) m.colorschm=IIF(_WINDOWS.OR._MAC,2,1) @ 1,1 EDIT m.codeline; SIZE 8,WCOLS()-2; NOMODIFY SCROLL; COLOR SCHEME (m.colorschm) @ 9,1 TO 9,WCOLS()-2 @ 10,1 SAY 'Error message : ' ?? PADR(ALLTRIM(m.msg),m.colright) @ 11,1 SAY 'Error number : ' ?? LTRIM(STR(m.error_no)) @ 12,1 SAY 'Procedure name: ' ?? PADR(ALLTRIM(m.prg_name),m.colright) @ 13,1 SAY 'Line number : ' ?? IIF(m.line_no>0,LTRIM(STR(m.line_no)),'Unknown') IF .NOT.EMPTY(ALIAS()) @ 14,1 SAY 'Database name : ' ?? PADR(ALLTRIM(DBF()),m.colright) @ 15,1 SAY 'Alias name : ' ?? ALIAS() @ 16,1 SAY 'Record number : ' ?? LTRIM(STR(RECNO())) ENDIF @ 17,1 TO 17,WCOLS()-2 @ 18,9 GET m.prompt ; PICTURE "@*HT \!\<Cancel;\<Suspend;\<Ignore" ; SIZE 1,11,8 ; DEFAULT 1 SET CURSOR ON READ CYCLE MODAL OBJECT 2 DO CASE CASE m.prompt=2 @ 18,0 CLEAR ACTIVATE SCREEN ACTIVATE WINDOW Command SET ESCAPE ON SUSPEND SET ESCAPE OFF RELEASE WINDOW win_prompt SET CURSOR &lastcursr ON ERROR &lasterror RETURN CASE m.prompt=3 RELEASE WINDOW win_prompt SET CURSOR &lastcursr ON ERROR &lasterror RETURN ENDCASE RELEASE WINDOW win_prompt m.gen_mode=.F. DO cleanup CANCEL * END errorhnd PROCEDURE esc_check PRIVATE m.i IF CHRSAW() m.i=INKEY('H') IF m.i=27 DO cleanup CANCEL ENDIF ENDIF RETURN * END esc_check PROCEDURE cleanup PARAMETERS m.sprcheck PRIVATE m.sprcheck,m.memline,m.find_str,m.at_pos,m.i,m.j,m.len_adj PRIVATE m.range1,m.range2,m.wchilds,m.winontop1,m.winontop2 RELEASE WINDOWS _wdelaybar,thrmomete IF USED('_TEMPFILE') USE IN _TEMPFILE ENDIF IF USED('CONFIGFP') USE IN CONFIGFP ENDIF IF USED('FOXSCX') USE IN FOXSCX ENDIF IF USED('SCXINSERT') USE IN SCXINSERT ENDIF IF USED('SCXBASE') USE IN SCXBASE ENDIF IF USED('SCXDATA') USE IN SCXDATA ENDIF IF USED('PJXBASE') USE IN PJXBASE ENDIF IF USED('PJXDATA') USE IN PJXDATA ENDIF IF USED('INSERTFILE') USE IN INSERTFILE ENDIF IF TYPE('m.fscxdata')#'C' IF USED('SPRDATA') USE IN SPRDATA ENDIF ON ERROR ACTIVATE SCREEN IF _WINDOWS SET MESSAGE TO ENDIF SET COMPATIBLE OFF SET EXACT OFF SET SAFETY OFF SET EXCLUSIVE ON SET UDFPARMS TO VALUE SET CURSOR ON SET MEMOWIDTH TO 50 SET ESCAPE ON WAIT CLEAR CLEAR TYPEAHEAD CANCEL ENDIF =erasedbf(m.projdbf,'PJXDATA') IF TYPE('m.scxcount')=='N'.AND.m.scxcount>0 FOR m.i = 1 TO m.scxcount IF TYPE('a_fscxdata(m.i)')=='C' m.fscxdata=a_fscxdata(m.i) ENDIF =erasedbf(m.fscxdata,'SCXDATA') ENDFOR ENDIF m.range1=0 m.range2=0 IF gen_mode.AND.m.sprcheck.AND..NOT.m.fromproj.AND.; m.compspr=='ON'.AND.FILE(m.fsprout) SET MEMOWIDTH TO 254 IF _WINDOWS SET MESSAGE TO PADR('Compiling Screen Code: '+LOWER(m.fsprout),79) ENDIF COMPILE (m.fsprout) IF _WINDOWS SET MESSAGE TO ENDIF IF m.dispspr=='ON'.AND.FILE(m.fsprerr) m.find_str='' m.range1=1 m.range2=1 IF .NOT.USED('SPRDATA') CREATE CURSOR SPRDATA (SPR M, INS M) INSERT BLANK APPEND MEMO SPR FROM (m.fsprout) OVERWRITE ENDIF SELECT SPRDATA m.len_adj=LEN(SPR) REPLACE SPR WITH STRTRAN(SPR,m.lf+';',';')+m.cr_lf m.len_adj=m.len_adj-LEN(SPR)+2 APPEND MEMO INS FROM (m.fsprerr) OVERWRITE m.at_pos=ATC(m.m_errline,INS) IF m.at_pos>0 m.i=VAL(SUBSTR(INS,m.at_pos+LEN(m.m_errline))) m.find_str=MLINE(SPR,m.i) IF .NOT.m.find_str$MLINE(INS,1) m.find_str=MLINE(INS,1) ENDIF FOR m.j = (m.i-1) TO 1 STEP -1 m.memline=MLINE(SPR,m.j) IF .NOT.RIGHT(m.memline,1)==';' EXIT ENDIF m.find_str=m.memline+m.cr_lf+m.find_str ENDFOR FOR m.j = m.i TO (MEMLINES(SPR)-1) m.memline=MLINE(SPR,m.j) IF .NOT.RIGHT(m.memline,1)==';' EXIT ENDIF m.find_str=m.find_str+m.cr_lf+m.memline ENDFOR IF .NOT.EMPTY(m.find_str) m.at_pos=AT(m.lf+m.find_str+m.cr,SPR) IF m.at_pos=0 m.at_pos=AT(m.cr+m.find_str+m.cr,SPR) ENDIF IF m.at_pos>0 m.range1=m.at_pos+1 m.range2=m.at_pos+LEN(m.find_str)+m.len_adj+1 ENDIF ENDIF ENDIF m.i=SROWS()-25-IIF(_WINDOWS.AND.SET('STATUS BAR')=='ON',1,0) DEFINE WINDOW _weditfile FROM 17+m.i,0 TO 24+m.i,SCOLS()-1; SYSTEM CLOSE FLOAT GROW MINIMIZE SHADOW ZOOM; COLOR SCHEME 8 MODIFY FILE (m.fsprerr) NOWAIT; RANGE 1,1 WINDOW _weditfile ZOOM WINDOW _weditfile NORM FROM 1+m.i,0 TO 15+m.i,SCOLS()-1 MODIFY FILE (m.fsprout) NOWAIT; RANGE m.range1,m.range2 WINDOW _weditfile RELEASE WINDOW _weditfile ENDIF ENDIF IF USED('SPRDATA') USE IN SPRDATA ENDIF WAIT CLEAR IF m.warnings>0 WAIT ALLTRIM(STR(m.warnings,8))+' warning'+IIF(m.warnings>1,'s',''); WINDOW NOWAIT ENDIF DO restoreset CLEAR TYPEAHEAD IF .NOT.gen_mode.OR.m.fromproj RETURN ENDIF m.wchilds=WCHILD()-IIF(m.range1=0,0,2) IF m.wchilds<=1 IF m.range1=0.AND.m.autorun=='ON'.AND.FILE(m.fsprout) KEYBOARD '{Ctrl+W}{Ctrl+F2}DO '+m.fsprout+CHR(13) ENDIF RETURN ENDIF m.winontop1='' FOR m.i = 1 TO m.wchilds m.winontop2=m.winontop1 m.winontop1=WCHILD(m.i-1) ENDFOR IF ATC('.PRO',m.winontop2)=0.OR.; .NOT.UPPER(trimext(m.winontop1))==UPPER(trimext(m.winontop2)) IF m.range1=0.AND.m.autorun=='ON'.AND.FILE(m.fsprout) KEYBOARD '{Ctrl+W}{Ctrl+F2}DO '+m.fsprout+CHR(13) ENDIF RETURN ENDIF IF m.range1=0 KEYBOARD '{Ctrl+W}' PLAIN IF m.autorun=='ON'.AND.FILE(m.fsprout) KEYBOARD '{Ctrl+W}{Ctrl+F2}DO '+m.fsprout+CHR(13) ENDIF ELSE KEYBOARD '{Ctrl+F1}{Ctrl+F1}{Ctrl+W}' PLAIN FOR m.i = 1 TO m.wchilds-1 KEYBOARD '{Ctrl+F1}' PLAIN ENDFOR ENDIF RETURN * END cleanup PROCEDURE restoreset m.drv_no=0 IF TYPE('m.lastselect')=='N' SELECT (m.lastselect) ENDIF SET MEMOWIDTH TO (m.lastmemow) ACTIVATE SCREEN @ 0,0 SAY '' IF m.lastsetudfp=='VALUE' SET UDFPARMS TO VALUE ELSE SET UDFPARMS TO REFERENCE ENDIF IF m.lastsetexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF IF m.lastsetexcl=='ON' SET EXCLUSIVE ON ELSE SET EXCLUSIVE OFF ENDIF IF EMPTY(m.lastsetpath) SET PATH TO ELSE SET PATH TO (m.lastsetpath) ENDIF IF m.lastsetsfty=='ON' SET SAFETY ON ELSE SET SAFETY OFF ENDIF IF m.lastsetcomp=='ON' SET COMPATIBLE ON ELSE SET COMPATIBLE OFF ENDIF ON ERROR IF _WINDOWS SET MESSAGE TO ENDIF SET CURSOR ON SET ESCAPE ON RETURN * END restoreset PROCEDURE restoreenv SET COMPATIBLE OFF SET EXACT OFF SET PATH TO (m.newsetpath) SET SAFETY OFF SET EXCLUSIVE ON SET UDFPARMS TO VALUE SET CURSOR OFF SET MEMOWIDTH TO 254 RETURN * END restoreenv FUNCTION evltxt PARAMETERS m.old_text PRIVATE m.old_text,m.new_text,m.eval_str,m.eval_str1,m.eval_str2,m.var_type PRIVATE m.at_pos,m.at_pos2,m.at_pos3,m.at_pos4,m.at_pos5,m.old_str,m.new_str PRIVATE m.i,m.j,m.at_line,m.onerror,m.cr_lf,m.evlmode,m.mthd_str,m.sellast IF TYPE('m.old_text')#'C' RETURN m.old_text ENDIF m.cr_lf=CHR(10)+CHR(13) m.onerror=ON('ERROR') m.new_text=m.old_text m.at_pos3=1 DO WHILE .T. m.at_pos=AT('{{',SUBSTR(m.old_text,m.at_pos3)) IF m.at_pos=0 EXIT ENDIF m.at_pos2=AT('}}',SUBSTR(m.old_text,m.at_pos+m.at_pos3-1)) IF m.at_pos2=0 EXIT ENDIF m.at_pos4=AT('{{',SUBSTR(m.old_text,m.at_pos+m.at_pos3+1)) IF m.at_pos4>0.AND.m.at_pos4<m.at_pos2 m.at_pos4=OCCURS('{{',SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,; m.at_pos2-m.at_pos4)) m.at_pos4=AT('{{',SUBSTR(m.old_text,m.at_pos+m.at_pos3-1),m.at_pos4) m.old_str=SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,m.at_pos2+1) m.eval_str=SUBSTR(m.old_str,3,LEN(m.old_str)-2) m.old_str=evltxt(m.eval_str) m.old_text=STRTRAN(m.old_text,m.eval_str,m.old_str) m.new_text=STRTRAN(m.new_text,m.eval_str,m.old_str) LOOP ENDIF m.old_str=SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,m.at_pos2+1) m.eval_str=ALLTRIM(SUBSTR(m.old_str,3,LEN(m.old_str)-4)) DO esc_check m.evlmode=.F. ON ERROR DO errorhnd WITH ERROR(),MESSAGE(),PROGRAM(),LINENO(),; m.old_str+m.cr_lf+'ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ'+; 'ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ'+; m.cr_lf+MESSAGE(1) DO CASE CASE EMPTY(m.eval_str) m.eval_str='' CASE LEFT(m.eval_str,2)=='&.' m.eval_str=SUBSTR(m.eval_str,3) &eval_str &&; ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ; Error occured during macro substitution of {{&. <expC> }}. m.eval_str='' CASE LEFT(m.eval_str,1)=='<' m.eval_str=insert(SUBSTR(m.eval_str,2)) &&; ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ; Error occured during evaluation of {{< <file> }}. CASE '::'$m.eval_str m.eval_str1='' m.eval_str2='' m.at_pos4=AT('||',m.eval_str) IF m.at_pos4>0 m.eval_str2=IIF(m.at_pos4>0,SUBSTR(m.eval_str,m.at_pos4+2),'') m.eval_str=LEFT(m.eval_str,m.at_pos4-1) ENDIF FOR m.i = 1 TO 2 m.at_pos4=AT('::',m.eval_str) m.evlmode=.T. m.eval_str=objdata(LEFT(m.eval_str,m.at_pos4-1),; SUBSTR(m.eval_str,m.at_pos4+2)) &&; ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ; Error occured during evaluation of {{ <expC1> :: <expC2> }}. IF m.i=1.AND..NOT.EMPTY(m.eval_str2) m.eval_str1=m.eval_str m.eval_str=m.eval_str2 LOOP ENDIF m.evlmode=.F. IF m.i=2 m.eval_str2=m.eval_str IF EMPTY(m.eval_str2) m.eval_str=m.eval_str1 EXIT ENDIF IF EMPTY(m.eval_str1) m.eval_str=m.eval_str2 EXIT ENDIF m.sellast=SELECT() IF .NOT.USED('_TEMPFILE') CREATE CURSOR _TEMPFILE (COMMENT M, SETUPCODE M) INSERT BLANK ENDIF SELECT _TEMPFILE LOCATE REPLACE COMMENT WITH m.eval_str2 REPLACE SETUPCODE WITH m.eval_str1 m.eval_str1='' m.eval_str2='' DO WHILE .T. =esc_check() m.mthd_str=wordsearch(m.c_method) IF m.mthd_str==m.null m.eval_str=COMMENT+m.cr_lf+SETUPCODE EXIT ENDIF IF EMPTY(m.mthd_str) REPLACE COMMENT WITH strtranc(m.c_method,m.m_method,1,1) LOOP ENDIF m.at_pos4=ATC(m.c_method+' '+m.mthd_str+m.cr,COMMENT+m.cr) IF m.at_pos4=0 REPLACE COMMENT WITH strtranc(m.c_method,m.m_method,1,1) LOOP ENDIF m.at_pos5=ATC(m.c_endmthd,SUBSTR(COMMENT,m.at_pos4)) IF m.at_pos5>0 m.at_pos5=m.at_pos5+LEN(m.c_endmthd) ELSE m.at_pos5=LEN(COMMENT)+1 ENDIF m.eval_str1=SUBSTR(COMMENT,m.at_pos4,m.at_pos5)+m.cr_lf REPLACE COMMENT WITH LEFT(COMMENT,m.at_pos4-1)+; SUBSTR(COMMENT,m.at_pos4+m.at_pos5) m.at_pos4=ATC(m.c_method+' '+m.mthd_str+m.cr,SETUPCODE+m.cr) IF m.at_pos4=0 LOOP ENDIF m.at_pos5=ATC(m.c_endmthd,SUBSTR(SETUPCODE,m.at_pos4)) IF m.at_pos5>0 m.at_pos5=m.at_pos5+LEN(m.c_endmthd) ELSE m.at_pos5=LEN(SETUPCODE)+1 ENDIF REPLACE SETUPCODE WITH LEFT(SETUPCODE,m.at_pos4-1)+m.eval_str1+; SUBSTR(SETUPCODE,m.at_pos4+m.at_pos5) ENDDO m.eval_str=SETUPCODE SELECT (m.sellast) ENDIF EXIT ENDFOR m.eval_str1='' m.eval_str2='' OTHERWISE m.eval_str=EVALUATE(m.eval_str) &&; ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ; Error occured during evaluation of {{ <expC> }}. ENDCASE IF EMPTY(m.onerror) ON ERROR ELSE ON ERROR &onerror ENDIF m.var_type=TYPE('m.eval_str') DO CASE CASE m.var_type=='C' m.new_str=m.eval_str CASE m.var_type=='N' m.new_str=ALLTRIM(STR(m.eval_str,24,12)) DO WHILE RIGHT(m.new_str,1)=='0' m.new_str=LEFT(m.new_str,LEN(m.new_str)-1) IF RIGHT(m.new_str,1)=='.' m.new_str=LEFT(m.new_str,LEN(m.new_str)-1) EXIT ENDIF ENDDO CASE m.var_type=='D' m.new_str=DTOC(m.eval_str) CASE m.var_type=='L' m.new_str=IIF(m.eval_str,'.T.','.F.') OTHERWISE m.new_str=m.old_str ENDCASE m.new_text=STRTRAN(m.new_text,m.old_str,m.new_str) m.at_pos2=m.at_pos+LEN(m.new_str) IF m.at_pos2<=0 EXIT ENDIF m.at_pos3=m.at_pos3+m.at_pos2 ENDDO m.j=0 DO WHILE '{{'$m.new_text =esc_check() m.i=LEN(m.new_text) m.new_text=evltxt(m.new_text) IF m.i=LEN(m.new_text) IF m.j>=2 EXIT ENDIF m.j=m.j+1 ENDIF ENDDO RETURN m.new_text * END evltxt FUNCTION evlrec PRIVATE m.evlflag,m.evlloop,m.i,m.field_name,m.field_type,m.field_eval m.evlflag=.F. m.evlloop=.T. DO WHILE m.evlloop m.evlloop=.F. FOR m.i = 1 TO FCOUNT() m.field_name=FIELD(m.i) m.field_type=TYPE(m.field_name) IF m.field_type#'M' LOOP ENDIF m.field_eval=EVALUATE(m.field_name) IF '{{'$m.field_eval REPLACE (m.field_name) WITH evltxt(m.field_eval) m.evlflag=.T. m.evlloop=.T. ENDIF ENDFOR EXIT ENDDO RETURN m.evlflag * END evlrec FUNCTION insblank PARAMETERS m.skiprec PRIVATE m.skiprec,m.lastfilter,m.r IF RECNO()<m.r_scxdata RETURN .F. ENDIF m.lastfilter=FILTER() SET FILTER TO IF TYPE('m.skiprec')#'N' m.skiprec=0 ENDIF SKIP m.skiprec IF m.skiprec>0.OR.BOF() SKIP -1 ENDIF INSERT BLANK m.r=RECNO() SCAN REST IF VPOS<0 REPLACE HPOS WITH HPOS+1 ENDIF IF HEIGHT<0 REPLACE WIDTH WITH WIDTH+1 ENDIF ENDSCAN GOTO m.r IF EMPTY(m.lastfilter) SET FILTER TO ELSE SET FILTER TO &lastfilter ENDIF RETURN .T. * END insblank FUNCTION insrec PARAMETERS m.skiprec PRIVATE m.skiprec IF TYPE('SETUPCODE')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF IF TYPE('m.skiprec')#'N' m.skiprec=0 ENDIF IF .NOT.insblank(m.skiprec) RETURN .F. ENDIF REPLACE OBJTYPE WITH 15, OBJCODE WITH 0 IF TYPE('PLATFORM')=='C' REPLACE PLATFORM WITH m.platform_ ENDIF REPLACE OBJTYPE WITH 15, OBJCODE WITH 0, EXPR WITH '',; VPOS WITH -0, HPOS WITH 0,; HEIGHT WITH 1, WIDTH WITH 1, PICTURE WITH '',; BOXCHAR WITH '', FILLCHAR WITH '', SCHEME WITH 0,; SCHEME2 WITH -1, COLORPAIR WITH '' IF TYPE('PLATFORM')=='C' REPLACE PENRED WITH -1, PENGREEN WITH -1, PENBLUE WITH -1,; FILLRED WITH -1, FILLGREEN WITH -1, FILLBLUE WITH -1,; PENSIZE WITH -1, PENPAT WITH -1, FONTFACE WITH '',; FONTSTYLE WITH 0, FONTSIZE WITH 0 ENDIF RETURN .T. * END insrec FUNCTION duprec PARAMETERS m.skiprec PRIVATE m.skiprec IF TYPE('SETUPCODE')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF IF TYPE('m.skiprec')#'N' m.skiprec=0 ENDIF RELEASE a_fscatter SCATTER TO a_fscatter MEMO IF .NOT.insblank(m.skiprec) RELEASE a_fscatter RETURN .F. ENDIF GATHER FROM a_fscatter MEMO RELEASE a_fscatter RETURN .T. * END duprec FUNCTION insobj PARAMETERS m.match_str,m.deldirect PRIVATE m.match_str,m.deldirect,m.objlib,m.objname,m.row,m.col,m.rows,m.cols PRIVATE m.row_offset,m.col_offset,m.lastexac,m.i,m.j,m.old_text,m.new_text PRIVATE m.memline,m.at_pos,m.at_line,m.trntxt_str IF m.deldirect DELETE ELSE =delobj1() ENDIF m.objlib='' m.objname=PADR(ALLTRIM(m.match_str),LEN(FOXSCX.OBJLIB_)+LEN(FOXSCX.OBJNAME_)) m.at_pos=AT('.',m.objname) IF m.at_pos>0 m.objlib=PADR(UPPER(CHRTRAN(ALLTRIM(LEFT(m.objname,m.at_pos-1)),; m.badchars,m.stdascii)),LEN(FOXSCX.OBJLIB_)) m.objname=ALLTRIM(SUBSTR(m.objname,m.at_pos+1)) ENDIF m.objlib=PADR(ALLTRIM(m.objlib),LEN(FOXSCX.OBJLIB_)) m.objname=PADR(ALLTRIM(m.objname),LEN(FOXSCX.OBJNAME_)) IF TYPE('m.inclibs')#'N' m.inclibs=0 ENDIF IF m.inclibs=0.AND.EMPTY(m.objlib) =warning(m.c_insobj,m.match_str) RETURN .F. ENDIF m.objname=PADR(CHRTRAN(m.objname,m.badchars,m.stdascii),; LEN(FOXSCX.OBJNAME_)) m.row=VPOS m.col=HPOS m.rows=HEIGHT m.cols=WIDTH m.trntxt_str='' m.at_line=ATCLINE(m.c_trntxt,COMMENT) IF m.at_line>0 FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_trntxt,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_trntxt,m.memline) IF m.at_pos=1 m.trntxt_str=m.trntxt_str+m.memline+m.cr_lf ENDIF ENDFOR ENDIF SELECT FOXSCX m.lstorder=ORDER() SET ORDER TO OBJNAME_ IF EMPTY(m.objlib) m.lstexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO m.inclibs SEEK UPPER(PADR(m.objname,LEN(OBJNAME_))+PADR(a_inclib(m.i),LEN(OBJLIB_))) IF .NOT.EOF() m.objlib=OBJLIB_ EXIT ENDIF ENDFOR IF m.lstexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ENDIF m.lastorder=ORDER() SEEK UPPER(m.objname+m.objlib) IF EOF() =warning(m.c_insobj,m.match_str) SET ORDER TO (m.lastorder) SELECT SCXDATA RETURN .F. ENDIF IF .NOT.EOF().AND.OBJTYPE#1.AND.OBJTYPE#2.AND.OBJTYPE#10 m.row_offset=ROW-VPOS m.col_offset=COL-HPOS RELEASE a_fields DIMENSION a_fields(1) =AFIELDS(a_fields) SCATTER TO a_fscatter MEMO SELECT SCXDATA =insblank() IF ALEN(a_fscatter)=(FCOUNT()-m.fcountadj) GATHER FROM a_fscatter MEMO ELSE m.lastexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO (FCOUNT()-m.fcountadj) m.j=ASCAN(a_fields,FIELD(m.i)) IF m.j=0 LOOP ENDIF REPLACE (FIELD(m.i)) WITH a_fscatter(INT(m.j/4)+1) ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ENDIF REPLACE VPOS WITH VPOS+m.row_offset, HPOS WITH HPOS+m.col_offset,; ACTIVTYPE WITH 2 IF TYPE('PLATFORM')=='C' REPLACE PLATFORM WITH m.platform_ ENDIF IF ATC(m.c_basobj,COMMENT)=0 =basobj2('') ENDIF IF TYPE('m.memvarmode')=='L'.AND.m.memvarmode m.old_text=ALLTRIM(MLINE(NAME,1)) m.at_pos=AT('.',m.old_text) m.new_text='m'+SUBSTR(m.old_text,m.at_pos) IF m.at_pos>0.AND.(m.at_pos#2.OR.; .NOT.UPPER(LEFT(m.old_text,2))=='M.').AND.; .NOT.m.old_text==m.new_text REPLACE NAME WITH m.new_text,; WHEN WITH strtranc(WHEN,m.old_text,m.new_text),; VALID WITH strtranc(VALID,m.old_text,m.new_text),; MESSAGE WITH strtranc(MESSAGE,m.old_text,m.new_text),; ERROR WITH strtranc(ERROR,m.old_text,m.new_text),; RANGELO WITH strtranc(RANGELO,m.old_text,m.new_text),; RANGEHI WITH strtranc(RANGEHI,m.old_text,m.new_text) ENDIF ENDIF IF .NOT.EMPTY(m.trntxt_str) REPLACE COMMENT WITH m.trntxt_str+COMMENT ENDIF RELEASE a_fscatter SKIP -1 ELSE =warning(m.c_insobj,m.match_str) ENDIF SELECT FOXSCX SET ORDER TO (m.lastorder) LOCATE SELECT SCXDATA RETURN .T. * END insobj FUNCTION insscx PARAMETERS m.scxname,m.deldirect PRIVATE m.scxname,m.deldirect,m.r,m.row,m.col,m.rows,m.cols PRIVATE m.row_offset,m.col_offset,m.lastexac,m.i,m.j,m.old_text,m.new_text PRIVATE m.memline,m.at_pos,m.at_line,m.trntxt_str IF m.deldirect DELETE ELSE =delobj1() ENDIF IF .NOT.'.'$m.scxname m.scxname=m.scxname+'.SCX' ENDIF IF .NOT.FILE(m.scxname) =warning(m.c_insscx,m.scxname) RETURN .F. ENDIF m.r=RECNO() m.row=VPOS m.col=HPOS m.rows=INT(HEIGHT-1) m.cols=INT(WIDTH-1) m.trntxt_str='' m.at_line=ATCLINE(m.c_trntxt,COMMENT) IF m.at_line>0 FOR m.i = m.at_line TO MEMLINES(COMMENT) m.memline=ALLTRIM(MLINE(COMMENT,m.i)) IF m.i>m.at_line.AND..NOT.'*:'$m.memline m.at_pos=AT(m.cr,COMMENT,m.i)+1 IF m.at_pos=1.OR.ATC(m.c_trntxt,SUBSTR(COMMENT,m.at_pos))=0 EXIT ENDIF LOOP ENDIF m.at_pos=ATC(m.c_trntxt,m.memline) IF m.at_pos=1 m.trntxt_str=m.trntxt_str+m.memline+m.cr_lf ENDIF ENDFOR ENDIF IF USED('SCXINSERT') SELECT SCXINSERT USE ELSE SELECT 0 ENDIF USE (m.scxname) ALIAS SCXINSERT IF TYPE('PLATFORM')=='C' SET FILTER TO PLATFORM==m.platform_ ENDIF LOCATE m.row_offset=m.row-VPOS m.col_offset=m.col-HPOS SCAN ALL FOR OBJTYPE#1.AND.OBJTYPE#2.AND.OBJTYPE#10.AND.; INT(VPOS)<=m.rows.AND.INT(HPOS)<=m.cols RELEASE a_fields DIMENSION a_fields(1) =AFIELDS(a_fields) SCATTER TO a_fscatter MEMO SELECT SCXDATA =insblank() IF ALEN(a_fscatter)=FCOUNT() GATHER FROM a_fscatter MEMO ELSE m.lastexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO FCOUNT() m.j=ASCAN(a_fields,FIELD(m.i)) IF m.j=0 LOOP ENDIF REPLACE (FIELD(m.i)) WITH a_fscatter(INT(m.j/4)+1) ENDFOR IF m.lastexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ENDIF RELEASE a_fields REPLACE VPOS WITH VPOS+m.row_offset, HPOS WITH HPOS+m.col_offset,; ACTIVTYPE WITH 2 IF TYPE('PLATFORM')=='C' REPLACE PLATFORM WITH m.platform_ ENDIF IF TYPE('m.memvarmode')=='L'.AND.m.memvarmode m.old_text=ALLTRIM(MLINE(NAME,1)) m.at_pos=AT('.',m.old_text) IF m.at_pos>0.AND.(m.at_pos#2.OR.; .NOT.UPPER(LEFT(m.old_text,2))=='M.').AND.; .NOT.m.old_text==m.new_text REPLACE NAME WITH 'm'+SUBSTR(NAME,m.at_pos) m.new_text=ALLTRIM(MLINE(NAME,1)) REPLACE WHEN WITH strtranc(WHEN,m.old_text,m.new_text),; VALID WITH strtranc(VALID,m.old_text,m.new_text),; MESSAGE WITH strtranc(MESSAGE,m.old_text,m.new_text),; ERROR WITH strtranc(ERROR,m.old_text,m.new_text),; RANGELO WITH strtranc(RANGELO,m.old_text,m.new_text),; RANGEHI WITH strtranc(RANGEHI,m.old_text,m.new_text) ENDIF ENDIF IF .NOT.EMPTY(m.trntxt_str) REPLACE COMMENT WITH m.trntxt_str+COMMENT ENDIF SELECT SCXINSERT ENDSCAN RELEASE a_fscatter USE IN SCXINSERT SELECT SCXDATA GOTO m.r RETURN .T. * END insscx FUNCTION defobj1 PARAMETERS m.objname PRIVATE m.objname IF TYPE('SETUPCODE')#'M' RETURN .F. ENDIF REPLACE SETUPCODE WITH m.c_defobj+' '+m.objname+m.cr_lf+SETUPCODE RETURN .T. * END defobj1 FUNCTION defobj2 PARAMETERS m.objname PRIVATE m.objname IF TYPE('COMMENT')#'M' RETURN .F. ENDIF REPLACE COMMENT WITH m.c_defobj+' '+m.objname+m.cr_lf+COMMENT RETURN .T. * END defobj2 FUNCTION basobj1 PARAMETERS m.objname PRIVATE m.objname IF TYPE('SETUPCODE')#'M' RETURN .F. ENDIF REPLACE SETUPCODE WITH SETUPCODE+m.cr_lf+m.c_basobj+' '+m.objname RETURN .T. * END basobj1 FUNCTION basobj2 PARAMETERS m.objname PRIVATE m.objname IF TYPE('COMMENT')#'M' RETURN .F. ENDIF REPLACE COMMENT WITH COMMENT+m.cr_lf+m.c_basobj+' '+m.objname RETURN .T. * END basobj2 FUNCTION delobj1 IF TYPE('SETUPCODE')#'M' RETURN .F. ENDIF REPLACE SETUPCODE WITH m.c_delete+m.cr_lf+SETUPCODE RETURN .T. * END delobj1 FUNCTION delobj2 IF TYPE('COMMENT')#'M' RETURN .F. ENDIF REPLACE COMMENT WITH m.c_delete+m.cr_lf+COMMENT RETURN .T. * END delobj2 FUNCTION instxt1 PARAMETERS m.textstr,m.skiprec PRIVATE m.textstr,m.skiprec,m.r IF TYPE('SETUPCODE')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF m.r=RECNO() IF TYPE('m.skiprec')#'N' m.skiprec=0 ENDIF IF m.skiprec#0 IF .NOT.insrec(m.skiprec) RETURN .F. ENDIF ENDIF REPLACE SETUPCODE WITH SETUPCODE+m.cr_lf+m.c_instxt+m.cr_lf+m.textstr GOTO m.r IF m.skiprec<0 SKIP ENDIF RETURN .T. * END instxt1 FUNCTION instxt2 PARAMETERS m.textstr,m.skiprec PRIVATE m.textstr,m.skiprec,m.r IF TYPE('COMMENT')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF m.r=RECNO() IF TYPE('m.skiprec')#'N' m.skiprec=0 ENDIF IF m.skiprec#0 IF .NOT.insrec(m.skiprec) RETURN .F. ENDIF ENDIF REPLACE COMMENT WITH COMMENT+m.cr_lf+m.c_instxt+m.cr_lf+m.textstr GOTO m.r IF m.skiprec<0 SKIP ENDIF RETURN .T. * END instxt2 FUNCTION clrtxt1 IF TYPE('SETUPCODE')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF REPLACE SETUPCODE WITH '' RETURN .T. * END clrtxt1 FUNCTION clrtxt2 IF TYPE('COMMENT')#'M'.OR.RECNO()<m.r_scxdata RETURN .F. ENDIF REPLACE COMMENT WITH '' RETURN .T. * END clrtxt2 FUNCTION insif1 PARAMETERS m.textstr PRIVATE m.textstr,m.sayrefresh m.sayrefresh=REFRESH IF TYPE('SETUPCODE')#'M'.OR.TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr).OR.; .NOT.instxt1('IF '+m.textstr,-1) RETURN .F. ENDIF IF instxt1('ENDIF',1) SKIP -1 REPLACE NEXT 3 REFRESH WITH m.sayrefresh SKIP -1 RETURN .T. ENDIF RETURN .F. * END insif1 FUNCTION insif2 PARAMETERS m.textstr PRIVATE m.textstr,m.sayrefresh m.sayrefresh=REFRESH IF TYPE('COMMENT')#'M'.OR.TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr).OR.; .NOT.instxt2('IF '+m.textstr,-1) RETURN .F. ENDIF IF instxt2('ENDIF',1) SKIP -1 REPLACE NEXT 3 REFRESH WITH m.sayrefresh SKIP -1 RETURN .T. ENDIF RETURN .F. * END insif2 FUNCTION size1 PARAMETERS m.textstr PRIVATE m.textstr IF TYPE('SETUPCODE')#'M' RETURN .F. ENDIF IF TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr) REPLACE SETUPCODE WITH m.c_nosize+m.cr_lf+SETUPCODE ELSE REPLACE SETUPCODE WITH m.c_size+' '+m.textstr+m.cr_lf+SETUPCODE ENDIF RETURN .T. * END size1 FUNCTION size2 PARAMETERS m.textstr PRIVATE m.textstr IF TYPE('COMMENT')#'M' RETURN .F. ENDIF IF TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr) REPLACE COMMENT WITH m.c_nosize+m.cr_lf+COMMENT ELSE REPLACE COMMENT WITH m.c_size+' '+m.textstr+m.cr_lf+COMMENT ENDIF RETURN .T. * END size2 FUNCTION default1 PARAMETERS m.textstr PRIVATE m.textstr IF TYPE('SETUPCODE')#'M'.OR.TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr) RETURN .F. ENDIF REPLACE SETUPCODE WITH m.c_default+' '+m.textstr+m.cr_lf+SETUPCODE RETURN .T. * END default1 FUNCTION default2 PARAMETERS m.textstr PRIVATE m.textstr IF TYPE('COMMENT')#'M'.OR.TYPE('m.textstr')#'C'.OR.EMPTY(m.textstr) RETURN .F. ENDIF REPLACE COMMENT WITH m.c_default+' '+m.textstr+m.cr_lf+COMMENT RETURN .T. * END default2 FUNCTION delrec DELETE RETURN .T. * END delrec FUNCTION drvobj DO CASE CASE RECNO()<m.r_scxdata RETURN .F. CASE DELETED() RETURN .F. ENDCASE RETURN .T. * drvobj FUNCTION drvenable PARAMETERS m.prog_name PRIVATE m.prog_name,m.var_name m.var_name='_'+UPPER(m.prog_name) IF IIF(TYPE('EVALUATE(m.var_name)')=='C',EVALUATE(m.var_name),; configfp(m.prog_name,'ON'))=='OFF' RETURN .F. ENDIF RETURN .T. * drvenable FUNCTION objsay RETURN '@ '+objpos()+' SAY '+EXPR * END objsay FUNCTION objpos IF INLIST(ALLTRIM(m.platform_),'WINDOWS','MAC') RETURN ALLTRIM(STR(VPOS,7,3))+','+ALLTRIM(STR(HPOS,7,3)) ENDIF RETURN ALLTRIM(STR(VPOS,3))+','+ALLTRIM(STR(HPOS,3)) * END objpos FUNCTION objdata PARAMETERS m.match_str,m.eval_str PRIVATE m.match_str,m.eval_str,m.new_str,m.mthd_str,m.at_pos,m.r m.new_str='' IF '.'$m.match_str.OR..NOT.USED('SCXDATA') RETURN libdata(m.match_str,m.eval_str) ENDIF m.match_str=PADR(CHRTRAN(ALLTRIM(m.match_str),m.badchars,m.stdascii),24) m.r=RECNO() GOTO m.r_scxdata LOCATE REST FOR PADR(CHRTRAN(wordsearch(m.c_defobj),; m.badchars,m.stdascii),24)==m.match_str IF EOF() IF TYPE('m.evlmode')=='L'.AND.m.evlmode m.new_str=libdata(m.match_str,m.eval_str) ELSE =warning('objdata()',m.match_str) ENDIF ELSE IF TYPE('m.eval_str')#'C'.OR.EMPTY(m.eval_str).OR.; UPPER(m.eval_str)=='COMMENT' m.eval_str=m.eval_cmnt ENDIF IF '::'$m.eval_str m.at_pos=AT('::',m.eval_str) m.mthd_str=SUBSTR(m.eval_str,m.at_pos+2) m.eval_str=LEFT(m.eval_str,m.at_pos-1) IF EMPTY(m.eval_str) m.eval_str=m.eval_cmnt ENDIF m.new_str=EVALUATE(m.eval_str) m.at_pos=ATC(m.c_method+' '+m.mthd_str+m.cr,m.new_str+m.cr) IF m.at_pos=0 =warning('objdata()',m.match_str+'::'+m.eval_str+'::'+m.mthd_str) m.new_str='' ELSE m.new_str=SUBSTR(m.new_str,m.at_pos) m.at_pos=ATC(m.c_endmthd,m.new_str) IF m.at_pos>0 m.new_str=LEFT(m.new_str,m.at_pos+LEN(m.c_endmthd)-1) ENDIF m.new_str=m.new_str+m.cr_lf ENDIF ELSE m.new_str=EVALUATE(m.eval_str) ENDIF ENDIF GOTO m.r RETURN m.new_str * END objdata FUNCTION libdata PARAMETERS m.match_str,m.eval_str PRIVATE m.match_str,m.eval_str,m.new_str,m.mthd_str,m.at_pos,m.i PRIVATE m.objlib,m.objname,m.lstselect,m.lstorder,m.lstexac m.new_str='' m.lstselect=SELECT() IF .NOT.openfoxscx() RETURN m.new_str ENDIF m.objlib='' m.objname=PADR(ALLTRIM(m.match_str),LEN(FOXSCX.OBJLIB_)+LEN(FOXSCX.OBJNAME_)) m.at_pos=AT('.',m.objname) IF m.at_pos>0 m.objlib=PADR(UPPER(CHRTRAN(ALLTRIM(LEFT(m.objname,m.at_pos-1)),; m.badchars,m.stdascii)),LEN(FOXSCX.OBJLIB_)) m.objname=ALLTRIM(SUBSTR(m.objname,m.at_pos+1)) ENDIF IF TYPE('m.inclibs')#'N' m.inclibs=0 ENDIF IF m.inclibs=0.AND.EMPTY(m.objlib) =warning('libdata()',m.match_str) RETURN m.new_str ENDIF m.objname=PADR(CHRTRAN(m.objname,m.badchars,m.stdascii),; LEN(FOXSCX.OBJNAME_)) SELECT FOXSCX m.lstorder=ORDER() SET ORDER TO OBJNAME_ IF EMPTY(m.objlib) m.lstexac=SET('EXACT') SET EXACT ON FOR m.i = 1 TO m.inclibs SEEK UPPER(PADR(m.objname,LEN(OBJNAME_))+PADR(a_inclib(m.i),LEN(OBJLIB_))) IF .NOT.EOF() m.objlib=OBJLIB_ EXIT ENDIF ENDFOR IF m.lstexac=='ON' SET EXACT ON ELSE SET EXACT OFF ENDIF ENDIF SEEK UPPER(m.objname+m.objlib) IF EOF() =warning('libdata()',m.match_str) ELSE IF TYPE('m.eval_str')#'C'.OR.EMPTY(m.eval_str).OR.; UPPER(m.eval_str)=='COMMENT' m.eval_str=m.eval_cmnt ENDIF IF '::'$m.eval_str m.at_pos=AT('::',m.eval_str) m.mthd_str=SUBSTR(m.eval_str,m.at_pos+2) m.eval_str=LEFT(m.eval_str,m.at_pos-1) IF EMPTY(m.eval_str) m.eval_str=m.eval_cmnt ENDIF m.new_str=EVALUATE(m.eval_str) m.at_pos=ATC(m.c_method+' '+m.mthd_str+m.cr,m.new_str+m.cr) IF m.at_pos=0 =warning('libdata()',m.match_str+'::'+m.eval_str+'::'+m.mthd_str) m.new_str='' ELSE m.new_str=SUBSTR(m.new_str,m.at_pos) m.at_pos=ATC(m.c_endmthd,m.new_str) IF m.at_pos>0 m.new_str=LEFT(m.new_str,m.at_pos+LEN(m.c_endmthd)-1)+m.cr_lf ENDIF ENDIF ELSE m.new_str=EVALUATE(m.eval_str) ENDIF ENDIF SET ORDER TO (m.lstorder) LOCATE SELECT (m.lstselect) RETURN m.new_str * END libdata FUNCTION insert PARAMETERS m.filename PRIVATE m.filename,m.lstselect IF .NOT.FILE(m.filename) =warning('insert()',m.filename) RETURN '' ENDIF m.lstselect=SELECT() IF USED('INSERTFILE') SELECT INSERTFILE LOCATE ELSE CREATE CURSOR INSERTFILE (FILEINFO M) SELECT INSERTFILE INSERT BLANK ENDIF APPEND MEMO FILEINFO FROM (m.filename) OVERWRITE SELECT (m.lstselect) RETURN INSERTFILE.FILEINFO * END insert